' --------------------------------------------------------------
' Bildausschnitt in das ICN-Format f�r RCS umwandeln: DOOTOICN |
' --------------------------------------------------------------
' Funktion: Ein Bild im DOODLE-Format (32000 Bytes) wird ge-
'   laden, dann kann mit der Maus ein Ausschnitt bestimmt werden
'   (Rechteck aufziehen an Mausposition), der dann in eine (bis
'   6144 Quadratpixel) oder mehrere ICN-Dateien f�r das RCS
'   umgewandelt wird.
' --------------------------------------------------------------
' 16. und 17.12.89  Peter Ubachs                               |
' --------------------------------------------------------------
FILESELECT "\*.DOO",".DOO",doo$ !Bild ausw„hlen
IF EXIST(doo$)
  BLOAD doo$,XBIOS(2)
  REPEAT
  UNTIL MOUSEK
  rx&=MOUSEX
  ry&=MOUSEY
  '
  x_alt&=rx&            !------------------------------------+
  y_alt&=ry&            !Leider st�rzte mir der Rechner      |
  SGET screen$          !bei GRAF_RUBBERBOX des ”fteren ab,  |
  REPEAT                !deshalb diese Eigenkonstruktion.    |
    x&=MAX(rx&+1,MOUSEX)!                                    |
    y&=MAX(ry&+1,MOUSEY)!                                    |
    IF x_alt&<>x& OR y_alt&<>y&                              !
      SPUT screen$      !                                    |
      BOX rx&,ry&,x&,y& !                                    |
      x_alt&=x&         !                                    |
      y_alt&=y&         !                                    |
      SHOWM             !Sollte GRAF_RUBBERBOX funktionieren |
    ENDIF               !(GfA-Basic-Update, anderes TOS ?!?),|
  UNTIL MOUSEK=0        !diese Zeilen entfernen und          |
  SPUT screen$          !das Kommenmtarzeichen vor der Zeile |
  br&=x&-rx&            !mit GRAF_RUBBERBOX l”schen          |
  h&=y&-ry&             !------------------------------------+
  '  ~GRAF_RUBBERBOX(rx&,ry&,1,1,br&,h&) !Rechteck aufziehen
  h&=MIN(383,h&) !maximale H”he 384 Pixel
  GET rx&,ry&,rx&+br&,ry&+h&,block$ !Block zur Kennzeichnung
  PUT rx&,ry&,block$,12             !invertieren
  breite_in_pixeln&=br&+1
  IF breite_in_pixeln& MOD 16               !Wenn beim Teilen
    breite_in_worten&=breite_in_pixeln&\16+1!durch 16 ein Rest
  ELSE                                      !bleibt, muž 1 ad-
    breite_in_worten&=breite_in_pixeln&/16  !diert werden, da
  ENDIF                  !nur ganze Worte abgespeichert werden
  zeilenzahl&=h&+1
  FILESELECT "\*.icn",".icn",icn$
  IF LEN(icn$)
    pfad$=LEFT$(icn$,RINSTR(icn$,"\"))
    icn$=MID$(icn$,RINSTR(icn$,"\")+1)
    IF INSTR(icn$,".") !Extender abschneiden
      icn$=LEFT$(icn$,INSTR(icn$,".")-1)
    ENDIF
    IF zeilenzahl&*breite_in_worten&>384
      icn$=LEFT$(icn$,6) !Platz f�r zweistellige Numerierung
      icn_nr&=0
      streifen_breite&=16*(384\zeilenzahl&)
      REPEAT
        icn_ausgeben(pfad$+icn$+RIGHT$("00"+STR$(icn_nr&),2)+".ICN",rx&,ry&,streifen_breite&-1)
        INC icn_nr&
        ADD rx&,streifen_breite&
        SUB br&,streifen_breite&
      UNTIL br&<streifen_breite&
      IF br&>0
        icn_ausgeben(pfad$+icn$+RIGHT$("00"+STR$(icn_nr&),2)+".ICN",rx&,ry&,br&)
      ENDIF
    ELSE
      icn_ausgeben(pfad$+icn$+".ICN",rx&,ry&,br&)
    ENDIF
  ENDIF
ENDIF
PROCEDURE icn_ausgeben(icn$,x1&,y1&,br&)
  ' šbergabeparameter: icn$:   Dateiname
  '                    x1&,y1&:Koordinaten der linken oberen
  '                            Ecke des Streifens
  '                    br&:    Breite des Streifens-1 (in Pixel)
  ' benutzte globale Variablen:
  '                    zeilenzahl&: H”he der Streifen   (  "  )
  '                    h&:          H”he der Streifen-1 (  "  )
  LOCAL block$,adr%,i&
  LOCAL breite_in_pixeln&,breite_in_worten&,anz_worte&
  GET x1&,y1&,x1&+br&,y1&+h&,block$
  PUT x1&,y1&,block$,12 !wieder normal darstellen
  GET x1&,y1&,x1&+br&,y1&+h&,block$
  breite_in_pixeln&=br&+1
  IF breite_in_pixeln& MOD 16
    breite_in_worten&=breite_in_pixeln&\16+1
  ELSE
    breite_in_worten&=breite_in_pixeln&/16
  ENDIF
  anz_worte&=zeilenzahl&*breite_in_worten&
  OPEN "O",#1,icn$
  PRINT #1,FN x$(breite_in_pixeln&);", ";FN x$(zeilenzahl&);", ";FN x$(anz_worte&);", "
  PRINT #1,"{ ";
  adr%=V:block$+6 !die ersten drei Worte(Breite,H”he,
  FOR i&=1 TO anz_worte&-1 !    Farbebenen) �berlesen
    PRINT #1,FN x$(WORD{adr%});", ";
    IF (i& MOD 4)=0 !vierspaltig ausgeben
      PRINT #1
    ENDIF
    ADD adr%,2
  NEXT i&
  PRINT #1,FN x$(WORD{adr%});" }"
  CLOSE #1
RETURN
DEFFN x$(x&)="0x"+RIGHT$("0000"+HEX$(x&),4) !hexadezimal ausgeben