DEFINT A-Z

'
' File Viewer for disk images V1.1 written by Peter Weighill July 1994.
'
'
' Aug 1994 - Added geoICON viewer. Press V to see a files icon.


CONST ver$ = "v1.1"

DECLARE SUB MAIN ()
DECLARE SUB SETUP ()
DECLARE SUB CENTER (row, text$)
DECLARE SUB LOAD (t, s)
DECLARE SUB TESTFILE (filename$)
DECLARE SUB SHOWSPRITE (data$)
DECLARE FUNCTION READ$ (pointer)

OPTION BASE 0
DIM SHARED blockrange(1 TO 355), tsoffset(1 TO 35, 0 TO 20) AS LONG
DIM SHARED buffer AS STRING * 256, numbsectors
DIM SHARED filetype(0 TO 16) AS STRING * 3, geotype$(1 TO 14)
DIM SHARED diskname AS STRING * 16, diskid AS STRING * 5
DIM SHARED geodisktype AS STRING * 17
DIM SHARED direntry(1 TO 144) AS STRING * 30


SETUP

'----------------------------------------------------------------------------

CLS
COLOR 14, 0: CENTER 1, "geoIMAGE for disk images " + ver$
CENTER 2, "by Peter Weighill"
COLOR 7: LOCATE 5, 10
INPUT "Disk image name "; filename$
IF UCASE$(RIGHT$(filename$, 4)) = ".D64" THEN filename$ = MID$(filename$, LEN(filename$) - 4)
IF filename$ = "" THEN PRINT , "No file requested.": SYSTEM

TESTFILE filename$

OPEN filename$ + ".d64" FOR BINARY AS 1

LOAD 18, 0

IF MID$(buffer, 3, 1) <> "A" THEN PRINT , "Not valid disk image.": BEEP: SYSTEM

diskname = MID$(buffer, 145, 16)
diskid = MID$(buffer, 163, 5)
geodisktype = MID$(buffer, 174, 17)

t = ASC(MID$(buffer, 1, 1))
s = ASC(MID$(buffer, 2, 1))

numbsectors = 0
DO
  IF t <> 18 AND s > 18 THEN PRINT , "67; ILLEGAL SYSTEM T OR S": BEEP: SYSTEM
  LOAD t, s
  FOR i = 0 TO 7
    direntry(numbsectors * 8 + i + 1) = MID$(buffer, 3 + i * 32, 30)
  NEXT i
  numbsectors = numbsectors + 1
  t = ASC(MID$(buffer, 1, 1))
  s = ASC(MID$(buffer, 2, 1))
LOOP UNTIL t = 0

MAIN

CLOSE 1

COLOR 7, 0: CLS : PRINT "Ready."

SYSTEM

'----------------------------------------------------------------------------

' Called when error is detected from the TESTFILE subroutine.

invalid:

PRINT , "DISK IMAGE DOES NOT EXIST."
PRINT
BEEP

SYSTEM

'----------------------------------------------------------------------------

' Geo File Types
DATA "Basic Prg"
DATA "Assembly Prg"
DATA "Data File"
DATA "System File"
DATA "Desk Accessory"
DATA "Application"
DATA "Appl Data"
DATA "Font File"
DATA "Print Driver"
DATA "Input Driver"
DATA "Disk Driver"
DATA "System Boot"
DATA "Temporary"
DATA "Auto Execute"

SUB CENTER (row, text$)

' Centers a line of text on a given row.

LOCATE row, INT(40 - (LEN(text$) / 2))
PRINT text$;

END SUB

SUB LOAD (t, s)

' Load a sector into the buffer.

SEEK 1, tsoffset(t, s)
GET 1, , buffer

END SUB

SUB MAIN

' The main program.

DIM display(16)
DIM box$(1 TO 7)

COLOR 15, 0
CLS
CENTER 1, CHR$(34) + diskname + "תת" + diskid + CHR$(34)
IF LEFT$(geodisktype, 11) = "GEOS format" THEN
  CENTER 2, geodisktype
END IF
COLOR 14
LOCATE 9, 40: PRINT "Home/End PgUp/PgDn Up/Down moves cursor"
LOCATE 10, 40: PRINT "Press V to view the Geofiles icon."

FOR j = 1 TO 16
  display(j) = j
NEXT j

position = 0
newposition = 1

DO
  IF newposition <> position THEN
    position = newposition
    IF numbsectors <> 1 THEN
      IF position < display(1) THEN
        FOR i = 1 TO 16
          display(i) = position + i - 1
        NEXT i
      END IF
      IF position > display(16) THEN
        FOR i = 1 TO 16
          display(i) = position + i - 16
        NEXT i
      END IF
    END IF
    COLOR 7, 0
    FOR i = 1 TO 16
      LOCATE i + 3, 5
      IF numbsectors = 1 AND i > 8 THEN
        PRINT SPACE$(28)
      ELSE
        f = ASC(MID$(direntry(display(i)), 1, 1))
        f$ = "*": IF (f AND 128) = 128 THEN f$ = " "
        f$ = f$ + filetype(f AND 15)
        IF (f AND 64) = 64 THEN f$ = f$ + "<" ELSE f$ = f$ + " "
        size = ASC(MID$(direntry(display(i)), 30, 1)) * 256 + ASC(MID$(direntry(display(i)), 29, 1))
        COLOR 7, 0
        PRINT USING "##### "; size;
        IF display(i) = position THEN COLOR , 1
        PRINT MID$(direntry(display(i)), 4, 16);
        COLOR 7, 0
        PRINT " "; f$
      END IF
    NEXT i
  END IF
 
  COLOR 3
  LOCATE 4, 40: PRINT USING "Number of entries: ###"; numbsectors * 8
  LOCATE 6, 40: PRINT USING "Current postion  : ###"; position

  FOR i = 1 TO 7
    box$(i) = ""
  NEXT i
  geodesc$ = SPACE$(319)
  geos = ASC(MID$(direntry(position), 23, 1))
 
' Geos file detection
 
  IF geos <> 0 AND geos < 14 THEN
    box$(2) = "Geofiletype: " + geotype$(geos)
    geoformat$ = "SEQ "
    IF ASC(MID$(direntry(position), 22, 1)) = 1 THEN geoformat$ = "VLIR"
    box$(1) = "Geoformat: " + geoformat$
    geotr = ASC(MID$(direntry(position), 20, 1))
    geosec = ASC(MID$(direntry(position), 21, 1))
    LOAD geotr, geosec
    box$(3) = "Geoclass: " + READ$(78)
    IF geos = 3 OR geos = 4 OR geos = 7 OR geos = 8 OR geos = 13 THEN
      box$(4) = SPACE$(39)
    ELSE
      box$(4) = "By: " + READ$(98)
    END IF
    IF geos <> 3 AND geos <> 7 THEN
      box$(5) = SPACE$(39)
    ELSE
      box$(5) = "From Appl: " + READ$(118)
    END IF
    IF geos <> 8 THEN
      box$(6) = SPACE$(39)
    ELSE
      geofontid = ASC(MID$(buffer, 130, 1)) * 256 + ASC(MID$(buffer, 129, 1))
      box$(6) = "Font ID: " + STR$(geofontid) + "    "
    END IF
    geoy$ = RIGHT$(STR$(ASC(MID$(direntry(position), 24, 1))), 2)
    geom$ = RIGHT$(STR$(ASC(MID$(direntry(position), 25, 1))), 2)
    geod$ = RIGHT$(STR$(ASC(MID$(direntry(position), 26, 1))), 2)
    geoh$ = RIGHT$(STR$(ASC(MID$(direntry(position), 27, 1))), 2)
    IF geoh$ = " 0" THEN geoh$ = "12"
    geoo$ = RIGHT$(STR$(ASC(MID$(direntry(position), 28, 1))), 2)
    box$(7) = "Date:" + geod$ + "/" + geom$ + "/" + geoy$ + "  " + geoh$ + ":" + geoo$

    geodesc$ = RTRIM$(LTRIM$(READ$(161)))
    DO
      ret = INSTR(geodesc$, CHR$(13))
      IF ret <> 0 THEN MID$(geodesc$, ret, 1) = ""
    LOOP UNTIL ret = 0
    geodesc$ = LEFT$("Desc: " + geodesc$ + SPACE$(319), 319)
  END IF

  LOCATE 21, 1: PRINT geodesc$;
  COLOR 11
  FOR i = 1 TO 7
    LOCATE 11 + i, 40: PRINT LEFT$(box$(i) + SPACE$(39), 39)
  NEXT i

  DO
    keyput$ = UCASE$(INKEY$)
  LOOP UNTIL keyput$ <> ""
  SELECT CASE keyput$
    CASE "V"
      IF geos <> 0 AND geos < 14 THEN
        SCREEN 7, , 1, 1
        LOCATE 4, 5
        PRINT MID$(direntry(position), 4, 16);
        SHOWSPRITE MID$(buffer, 6, 63)
        LOCATE 16, 20
        PRINT "Press any key."
        DO: LOOP UNTIL INKEY$ <> ""
        SCREEN 0, , 0, 0
        WIDTH 80
        COLOR 15, 0
        CLS
        CENTER 1, CHR$(34) + diskname + "תת" + diskid + CHR$(34)
        IF LEFT$(geodisktype, 11) = "GEOS format" THEN
          CENTER 2, geodisktype
        END IF
        COLOR 14
        LOCATE 9, 40: PRINT "Home/End PgUp/PgDn Up/Down moves cursor"
        LOCATE 10, 40: PRINT "Press V to view the Geofiles icon."
        newposition = position
        position = 0
      ELSE
        BEEP
      END IF
    CASE CHR$(0) + "O"
      newposition = numbsectors * 8
    CASE CHR$(0) + "G"
      newposition = 1
    CASE CHR$(0) + "P"
      newposition = position + 1: IF newposition > numbsectors * 8 THEN newposition = numbsectors * 8
    CASE CHR$(0) + "H"
      newposition = position - 1: IF newposition < 1 THEN newposition = 1
    CASE CHR$(0) + "Q"
      newposition = position + 16: IF newposition > numbsectors * 8 THEN newposition = numbsectors * 8
      temp = display(1): IF temp > numbsectors * 8 - 31 THEN temp = numbsectors * 8 - 31
      IF numbsectors = 1 THEN temp = -15
      FOR i = 1 TO 16
        display(i) = temp + i + 15
      NEXT i
    CASE CHR$(0) + "I"
      newposition = position - 16: IF newposition < 1 THEN newposition = 1
      temp = display(1): IF temp < 16 THEN temp = 17
      FOR i = 1 TO 16
        display(i) = temp + i - 17
      NEXT i
    CASE ELSE
  END SELECT
LOOP UNTIL keyput$ = CHR$(27)

END SUB

FUNCTION READ$ (pointer)

' Read data from current sector (stored in buffer) from a starting postion
' defined by pointer until a null byte of the end of the sector is reached
' Also, ascii values between 192 and 219 are converted.

a$ = ""
b$ = ""
p = pointer

DO
  a$ = a$ + b$
  b$ = MID$(buffer, p, 1)
  b = ASC(b$)
  IF b > 192 AND b < 219 THEN b$ = CHR$(b - 128)
  p = p + 1
LOOP UNTIL b$ = CHR$(0) OR p = 255

READ$ = a$

END FUNCTION

SUB SETUP

' Setup initial constants.

FOR i = 1 TO 35
  blockrange(i) = 20 + (i > 17) * 2 + (i > 24) + (i > 30)
NEXT i

offset& = 1
FOR i = 1 TO 35
  FOR j = 0 TO 20
    IF j > blockrange(i) THEN EXIT FOR
    tsoffset(i, j) = offset&: offset& = offset& + 256
  NEXT j
NEXT i

buffer = ""

FOR i = 1 TO 144
  direntry(i) = STRING$(30, 0)
NEXT i

filetype(0) = "DEL"
filetype(1) = "SEQ"
filetype(2) = "PRG"
filetype(3) = "USR"
filetype(4) = "REL"

FOR i = 5 TO 15
  filetype(i) = "???"
NEXT i

FOR i = 1 TO 14
  READ geotype$(i)
NEXT i

END SUB

SUB SHOWSPRITE (data$)

x1 = 0
ypos = 70

FOR i = 0 TO 62
  xpos = 140 + x1 * 8
  d$ = MID$(data$, i + 1, 1)

  LINE (xpos, ypos)-STEP(15, 0), , , ASC(d$)
 
  x1 = x1 + 1: IF x1 = 3 THEN x1 = 0: ypos = ypos + 1
NEXT i

END SUB

SUB TESTFILE (filename$)

' Test to check if file exists.

ON ERROR GOTO invalid

OPEN filename$ + ".d64" FOR INPUT AS 1
CLOSE 1

ON ERROR GOTO 0

END SUB