program D64EDir; {$path "inc/"} {$incl "lib/intuition.lib"} {$incl "lib/graphics.lib"} {$incl "intuition/screens.h"} {$incl "graphics/view.h"} {$incl "libraries/diskfont.h"} {$incl "exec/io.h"} {$incl "exec/ports.h"} type colors = array[0..3] of integer; grafText = record h, v, len: integer; txt: string[40] end; block = array[0..255] of byte; var revVid, error: Boolean; ch: char; fType, byt: byte; lenSep, drive, low, high, rowNo, lineCnt, t, s, blk, size, errCode, status, i, j: integer; ptrScr: ^Screen; ptrWin: ^Window; ptrVP: ^ViewPort; ptrRP: ^RastPort; ptrMP: ^MsgPort; ptrIOR: ^IOStdReq; blues: colors; sep: string[3]; cnt: string[4]; fileT: string[5]; dName: string[18]; fName, padding: string[16]; txt: string[40]; path: string[64]; font64: TextAttr; huh: ^TextFont; newS: NewScreen; lines: array[0..7] of grafText; f: file; disk: array[0..682] of block; procedure showLine(lineK: integer); begin Move(ptrRP, lines[lineK].h * 8, lines[lineK].v * 8 + 7); GrafxText(ptrRP, ^lines[lineK].txt, lines[lineK].len) end; function keybdRd: char; var c: char; status: long; begin ptrIOR^.IO_COMMAND := CMD_READ; ptrIOR^.IO_DATA := ^c; ptrIOR^.IO_LENGTH := 1; status := DoIO(ptrIOR); keybdRd := c end; function toBlk(trk, sec: integer): integer; var b: integer; begin if (trk < 1) or (trk > 35) or (sec > 20) then b := -1 else if trk < 18 then b := (trk - 1 ) * 21 + sec else if trk < 25 then b := 357 + (trk - 18) * 19 + sec else if trk < 31 then b := 490 + (trk - 25) * 18 + sec else b := 598 + (trk - 31) * 17 + sec; if b >= 683 then toBlk := -1 else toBlk := b end; begin padding := ' '; blues[0] := $077E; blues[1] := $0EEE; blues[2] := $077E; blues[3] := $011C; lines[0].h := 4; lines[0].v := 1; lines[0].txt := '**** COMMODORE 64 BASIC V2 ****'; lines[1].h := 1; lines[1].v := 3; lines[1].txt := '64K RAM SYSTEM 38911 BASIC BYTES FREE'; lines[2].h := 0; lines[2].v := 5; lines[2].txt := 'READY.'; lines[3].h := 0; lines[3].v := 6; lines[3].txt := 'LOAD"$",8'; lines[4].h := 0; lines[4].v := 8; lines[4].txt := 'SEARCHING FOR $'; lines[5].h := 0; lines[5].v := 9; lines[5].txt := 'LOADING'; lines[6].h := 0; lines[6].v := 10; lines[6].txt := 'READY.'; lines[7].h := 0; lines[7].v := 11; lines[7].txt := 'LIST'; for i := 0 to 7 do lines[i].len := length(lines[i].txt); OpenLib(IntBase, 'intuition.library', 0); OpenLib(DiskFontBase, 'diskfont.library', 0); OpenGfx; font64.ta_Name := 'C64Umod.font'; font64.ta_YSize := 8; font64.ta_Style := 0; font64.ta_Flags := 0; huh := OpenDiskFont(^font64); newS.LeftEdge := 0; newS.TopEdge := 0; newS.Width := 320; newS.Height := 200; newS.Depth := 2; newS.DetailPen := 1; newS.BlockPen := 0; newS.ViewModes := 0; newS._Type := CUSTOMSCREEN; newS.Font := ^font64; newS.DefaultTitle := '15x1 Directory Display Screen'; ptrScr := OpenScreen(^newS); ptrVP := ^ptrScr^.ViewPort; ptrWin := Open_Window(0, 0, 320, 200, 0, 1, 0, SMART_REFRESH or ACTIVATE or BORDERLESS or BACKDROP, '15x1 Directory Display Window', ptrScr, 0, 0, 320, 200); ptrRP := ptrWin^.RPort; ptrMP := CreateMsgPort; ptrIOR := CreateIORequest(ptrMP, sizeof(IOStdReq)); ptrIOR^.IO_DATA := ptrWin; ptrIOR^.IO_LENGTH := 132; status := OpenDevice('console.device', 0, ptrIOR, 0); ShowTitle(ptrScr, {false}0); SetAPen(ptrRP, 2); SetBPen(ptrRP, 3); SetRast(ptrRP, 3); LoadRGB4(ptrVP, ^blues, 4); for i := 0 to 7 do showLine(i); if ParamCount <> 1 then writeln('usage: D64Dir filename') else begin path := ParamStr(1) + '.D64'; assign(f, path); reset(f); if eof(f) then writeln('''', path, ''' not found!') else begin seek(f, 0); { *** COMPILER BUG WORKAROUND *** } for i := 0 to 682 do blockread(f, disk[i], 2); close(f); blk := toBlk(18, 0); dName := ''; for i := 144 to 161 do begin byt := disk[blk][i]; if byt <> $A0 then dName := dName + chr(byt) end; size := length(dName); txt := '0 '; Move(ptrRP, 0, 12 * 8 + 7); GrafxText(ptrRP, ^txt, 2); write(txt); txt := '"' + dName + '"' + copy(padding, 1, 17 - size); for i := 162 to 166 do txt := txt + (chr(disk[blk][i])); SetDrMd(ptrRP, 5); GrafxText(ptrRP, ^txt, length(txt)); SetDrMd(ptrRP, 1); txt := #$9B + '7m' + txt + #$9B + '0m'; writeln(txt); rowNo := 12; lineCnt := 12; error := false; repeat t := disk[blk][0]; s := disk[blk][1]; if t <> 0 then begin blk := toBlk(t, s); if blk < 0 then begin writeln('Track = ', t, ' Sector = ', s, ' is invalid!'); t := 0; error := true end else for i := 0 to 7 do begin fType := disk[blk][2 + i * 32]; if fType <> 0 then begin size := disk[blk][2 + 29 + i * 32] * 256 + disk[blk][2 + 28 + i * 32]; cnt := intStr(size); fName := ''; for j := 0 to 15 do begin byt := disk[blk][2 + 3 + i * 32 + j]; if byt <> 160 then fName := fName + chr(byt) end; case fType of $01: fileT := '*SEQ'; $02: fileT := '*PRG'; $03: fileT := '*USR'; $04: fileT := '*REL'; $80: fileT := ' DEL'; $81: fileT := ' SEQ'; $82: fileT := ' PRG'; $83: fileT := ' USR'; $84: fileT := ' REL'; $C0: fileT := ' DEL<'; $C1: fileT := ' SEQ<'; $C2: fileT := ' PRG<'; $C3: fileT := ' USR<'; $C4: fileT := ' REL<' else fileT := ' UNK' end; txt := cnt + copy(padding, 1, 5 - length(cnt)) + '"' + fName + '"' + copy(padding, 1, 16 - length(fName)) + fileT; if lineCnt mod 24 = 0 then ch := keybdRd; lineCnt := lineCnt + 1; if rowNo > 23 then ScrollRaster(ptrRP, 0, 8, 0, 0, 319, 199) else rowNo := rowNo + 1; Move(ptrRP, 0, rowNo * 8 + 7); GrafxText(ptrRP, ^txt, length(txt)); writeln(txt) end end end until t = 0; if not error then begin blk := toBlk(18, 0); size := 0; for i := 0 to 16 do size := size + disk[blk][4 + i * 4]; for i := 18 to 34 do size := size + disk[blk][4 + i * 4]; txt := intStr(size) + ' BLOCKS FREE.'; if rowNo > 23 then ScrollRaster(ptrRP, 0, 8, 0, 0, 319, 199) else rowNo := rowNo + 1; Move(ptrRP, 0, rowNo * 8 + 7); GrafxText(ptrRP, ^txt, length(txt)); writeln(txt) end; ch := keybdRd; end end; CloseDevice(ptrIOR); DeleteIORequest(ptrIOR); DeleteMsgPort(ptrMP); Close_Window(ptrWin); CloseScreen(ptrScr) end.