'***************************************************************************
'*  Pretvaranje TIF formata u SCR format za REKLAMNI PANO 128x64 tacaka V4 *
'*  Copyright (C) 1993. by: Stankovic Goran dipl.ing.el.                   *
'*  www.qsl.net/yt2fsg      goranstank@email.com                           *
'***************************************************************************
memo% = 16 * 1024
DIM mem%(memo%), ek%(1024)
CLOSE
CLS
PRINT "************************************************************************"
PRINT "*  Pretvaranje iPhoto Deluxe TIF formata"
PRINT "*  u SCR format za REKLAMNI PANO 128x64 tacaka"
PRINT "*  Copyright (C) 1993. by: Stankovic Goran dipl.ing.el."
PRINT "************************************************************************"

pocetak:
LINE INPUT " File (*.TIF) >"; imef$
imef$ = UCASE$(imef$)
IF LEN(imef$) < 1 THEN
  PRINT
  FILES "*.TIF"
  GOTO pocetak
END IF
imef1$ = imef$ + ".TIF"
imef2$ = imef$ + ".SCR"
OPEN imef1$ FOR RANDOM AS #1
OPEN imef2$ FOR OUTPUT AS #2
FIELD #1, 128 AS a1$
GET #1
a2$ = (MID$(a1$, 1, 16))
pt$ = CHR$(73) + CHR$(73) + CHR$(42) + CHR$(0) + CHR$(8) + CHR$(0) + CHR$(0) + CHR$(0)
pt$ = pt$ + CHR$(15) + CHR$(0) + CHR$(254) + CHR$(0) + CHR$(4) + CHR$(0) + CHR$(1) + CHR$(0)
IF a2$ <> pt$ THEN
  PRINT "File nije radjen u iPHOTO DELUXE *.TIF formatu !"
  CLOSE
  GOTO pocetak
END IF
yduz% = ASC(MID$(a1$, 44, 1)) * 256 + ASC(MID$(a1$, 43, 1))
sduz% = ASC(MID$(a1$, 128, 1)) * 256 + ASC(MID$(a1$, 127, 1))
xduz% = sduz% / yduz%
PRINT "æirina slike ="; xduz% * 8
PRINT "Visina slike ="; yduz%

a% = 0: b% = 0: c% = 0: m% = 0: a3$ = ""
GET #1
j% = 67
  DO
    a2$ = MID$(a1$, j%, 1)
    
    mem%(m%) = ASC(a2$)
    m% = m% + 1
    IF m% > sduz% - 1 OR m% > memo% - 1 THEN GOTO slika
    j% = j% + 1
    IF j% > 128 THEN
      IF EOF(1) THEN GOTO slika
      j% = 1
      GET #1
    END IF
  LOOP

slika:
CLOSE #1
GOSUB pause
i% = 0: y2% = 63: x2% = 15
IF yduz% < 64 THEN y2% = yduz% - 1
FOR y1% = 0 TO y2%
  FOR x1% = 0 TO 15
    IF x1% < xduz% - 1 THEN
       ek%(i%) = 255 - mem%(y1% * xduz% + x1%)
    END IF
    i% = i% + 1
  NEXT x1%
NEXT y1%

FOR i% = 0 TO 1023
      PRINT #2, CHR$(ek%(i%));
NEXT i%
CLOSE

slika3:
CLS
SCREEN 2
'------------------------------------------------------
DEF SEG = 47104     '&HB8000
FOR j% = 0 TO 31
FOR k% = 0 TO 1
FOR i% = 0 TO 15
  b% = ek%(i% + j% * 32 + k% * 16)
  b0% = (b% AND 128) * 1.5 + (b% AND 64) * .75 + (b% AND 32) * .375 + (b% AND 16) * .1875
  b1% = (b% AND 8) * 24 + (b% AND 4) * 12 + (b% AND 2) * 6 + (b% AND 1) * 3
  POKE i% * 2 + j% * 80 + k% * 8192, b0%
  POKE i% * 2 + 1 + j% * 80 + k% * 8192, b1%
NEXT i%
NEXT k%
NEXT j%
DEF SEG
GOTO kraj

FOR b1% = 0 TO 63
  FOR b2% = 0 TO 15
    IF b2% < xduz% THEN
      c% = 255 - mem%(b1% * xduz% + b2%)
      PRINT #2, CHR$(c%);
    ELSE
      PRINT #2, CHR$(0);
    END IF
  NEXT b2%
NEXT b1%
CLOSE

ekran1:

SCREEN 1
FOR a1% = 0 TO 63
  FOR a% = 0 TO 15
  IF a% < xduz% THEN
  n% = mem%(a1% * xduz% + a%)
  ELSE
  n% = 255
  END IF
  y% = a1%
    FOR i% = 7 TO 0 STEP -1
    j% = 2 ^ i%
    m% = n%
    n% = INT(n% / j%)
    x% = a% * 8 + 7 - i%
      IF n% = 1 THEN
        PSET (x%, y%)
      END IF
      n% = m% - n% * j%
    NEXT i%
  NEXT a%
NEXT a1%
CLOSE
GOTO kraj


'----------------------------------------------------
ekran2:
SCREEN 2
FOR a1% = 0 TO yduz%
  FOR a% = 0 TO xduz% - 1
  n% = mem%(a1% * xduz% + a%)
  y% = a1%
    FOR i% = 7 TO 0 STEP -1
    j% = 2 ^ i%
    m% = n%
    n% = INT(n% / j%)
    x% = a% * 8 + 7 - i%
      IF n% = 1 THEN
        PSET (x%, y%)
      END IF
      n% = m% - n% * j%
    NEXT i%
  NEXT a%
NEXT a1%

kraj:
CLOSE
DO
ink$ = INKEY$
IF ink$ <> "" THEN END
LOOP
END

pause:
vreme = 20000
FOR pp = 0 TO vreme
ink$ = INKEY$
IF ink$ <> "" THEN pp = vreme
NEXT pp
RETURN