home *** CD-ROM | disk | FTP | other *** search
/ Dream 45 / Amiga_Dream_45.iso / Amiga / emulation / d64edir.lha / D64EDir.p < prev    next >
Text File  |  1997-09-10  |  9KB  |  285 lines
  1. program D64EDir;
  2.  
  3. {$path "inc/"}
  4. {$incl "lib/intuition.lib"}
  5. {$incl "lib/graphics.lib"}
  6. {$incl "intuition/screens.h"}
  7. {$incl "graphics/view.h"}
  8. {$incl "libraries/diskfont.h"}
  9. {$incl "exec/io.h"}
  10. {$incl "exec/ports.h"}
  11.  
  12. type colors = array[0..3] of integer;
  13.      grafText = record
  14.                   h,
  15.                   v,
  16.                   len: integer;
  17.                   txt: string[40]
  18.                 end;
  19.      block = array[0..255] of byte;
  20.  
  21. var revVid, error: Boolean;
  22.     ch: char;
  23.     fType, byt: byte;
  24.     lenSep, drive,
  25.     low, high, rowNo, lineCnt, t, s, blk, size, errCode, status, i, j: integer;
  26.     ptrScr: ^Screen;
  27.     ptrWin: ^Window;
  28.     ptrVP: ^ViewPort;
  29.     ptrRP: ^RastPort;
  30.     ptrMP: ^MsgPort;
  31.     ptrIOR: ^IOStdReq;
  32.     blues: colors;
  33.     sep: string[3];
  34.     cnt: string[4];
  35.     fileT: string[5];
  36.     dName: string[18];
  37.     fName, padding: string[16];
  38.     txt: string[40];
  39.     path: string[64];
  40.     font64: TextAttr;
  41.     huh: ^TextFont;
  42.     newS: NewScreen;
  43.     lines: array[0..7] of grafText;
  44.     f: file;
  45.     disk: array[0..682] of block;
  46.  
  47. procedure showLine(lineK: integer);
  48.   begin
  49.     Move(ptrRP, lines[lineK].h * 8, lines[lineK].v * 8 + 7);
  50.     GrafxText(ptrRP, ^lines[lineK].txt, lines[lineK].len)
  51.   end;
  52.  
  53. function keybdRd: char;
  54.   var c: char;
  55.       status: long;
  56.   begin
  57.     ptrIOR^.IO_COMMAND := CMD_READ;
  58.     ptrIOR^.IO_DATA := ^c;
  59.     ptrIOR^.IO_LENGTH := 1;
  60.     status := DoIO(ptrIOR);
  61.     keybdRd := c
  62.   end;
  63.  
  64. function toBlk(trk, sec: integer): integer;
  65.   var b: integer;
  66.   begin
  67.     if (trk < 1) or (trk > 35) or (sec > 20)
  68.         then b := -1
  69.       else if trk < 18
  70.                then b := (trk - 1 ) * 21 + sec
  71.       else if trk < 25
  72.                then b := 357 + (trk - 18) * 19 + sec
  73.       else if trk < 31
  74.                then b := 490 + (trk - 25) * 18 + sec
  75.       else b := 598 + (trk - 31) * 17 + sec;
  76.     if b >= 683
  77.         then toBlk := -1
  78.       else toBlk := b
  79.   end;
  80.  
  81. begin
  82.   padding := '                ';
  83.   blues[0] := $077E;
  84.   blues[1] := $0EEE;
  85.   blues[2] := $077E;
  86.   blues[3] := $011C;
  87.   lines[0].h := 4;
  88.   lines[0].v := 1;
  89.   lines[0].txt := '**** COMMODORE 64 BASIC V2 ****';
  90.   lines[1].h := 1;
  91.   lines[1].v := 3;
  92.   lines[1].txt := '64K RAM SYSTEM  38911 BASIC BYTES FREE';
  93.   lines[2].h := 0;
  94.   lines[2].v := 5;
  95.   lines[2].txt := 'READY.';
  96.   lines[3].h := 0;
  97.   lines[3].v := 6;
  98.   lines[3].txt := 'LOAD"$",8';
  99.   lines[4].h := 0;
  100.   lines[4].v := 8;
  101.   lines[4].txt := 'SEARCHING FOR $';
  102.   lines[5].h := 0;
  103.   lines[5].v := 9;
  104.   lines[5].txt := 'LOADING';
  105.   lines[6].h := 0;
  106.   lines[6].v := 10;
  107.   lines[6].txt := 'READY.';
  108.   lines[7].h := 0;
  109.   lines[7].v := 11;
  110.   lines[7].txt := 'LIST';
  111.   for i := 0 to 7
  112.     do lines[i].len := length(lines[i].txt);
  113.   OpenLib(IntBase, 'intuition.library', 0);
  114.   OpenLib(DiskFontBase, 'diskfont.library', 0);
  115.   OpenGfx;
  116.   font64.ta_Name := 'C64Umod.font';
  117.   font64.ta_YSize := 8;
  118.   font64.ta_Style := 0;
  119.   font64.ta_Flags := 0;
  120.   huh := OpenDiskFont(^font64);
  121.   newS.LeftEdge := 0;
  122.   newS.TopEdge := 0;
  123.   newS.Width := 320;
  124.   newS.Height := 200;
  125.   newS.Depth := 2;
  126.   newS.DetailPen := 1;
  127.   newS.BlockPen := 0;
  128.   newS.ViewModes := 0;
  129.   newS._Type := CUSTOMSCREEN;
  130.   newS.Font := ^font64;
  131.   newS.DefaultTitle := '15x1 Directory Display Screen';
  132.   ptrScr := OpenScreen(^newS);
  133.   ptrVP := ^ptrScr^.ViewPort;
  134.   ptrWin := Open_Window(0,
  135.                         0,
  136.                         320,
  137.                         200,
  138.                         0,
  139.                         1,
  140.                         0,
  141.                         SMART_REFRESH or ACTIVATE or BORDERLESS or BACKDROP,
  142.                         '15x1 Directory Display Window',
  143.                         ptrScr,
  144.                         0,
  145.                         0,
  146.                         320,
  147.                         200);
  148.   ptrRP := ptrWin^.RPort;
  149.   ptrMP := CreateMsgPort;
  150.   ptrIOR := CreateIORequest(ptrMP, sizeof(IOStdReq));
  151.   ptrIOR^.IO_DATA := ptrWin;
  152.   ptrIOR^.IO_LENGTH := 132;
  153.   status := OpenDevice('console.device', 0, ptrIOR, 0);
  154.   ShowTitle(ptrScr, {false}0);
  155.   SetAPen(ptrRP, 2);
  156.   SetBPen(ptrRP, 3);
  157.   SetRast(ptrRP, 3);
  158.   LoadRGB4(ptrVP, ^blues, 4);
  159.   for i := 0 to 7
  160.     do showLine(i);
  161.   if ParamCount <> 1
  162.       then writeln('usage: D64Dir filename')
  163.     else begin
  164.       path := ParamStr(1) + '.D64';
  165.       assign(f, path);
  166.       reset(f);
  167.       if eof(f)
  168.           then writeln('''', path, ''' not found!')
  169.         else begin
  170.           seek(f, 0);  { *** COMPILER BUG WORKAROUND *** }
  171.           for i := 0 to 682
  172.             do blockread(f, disk[i], 2);
  173.           close(f);
  174.           blk := toBlk(18, 0);
  175.           dName := '';
  176.           for i := 144 to 161
  177.             do begin
  178.               byt := disk[blk][i];
  179.               if byt <> $A0
  180.                   then dName := dName + chr(byt)
  181.             end;
  182.           size := length(dName);
  183.           txt := '0 ';
  184.           Move(ptrRP, 0, 12 * 8 + 7);
  185.           GrafxText(ptrRP, ^txt, 2);
  186.           write(txt);
  187.           txt := '"' + dName + '"' + copy(padding, 1, 17 - size);
  188.           for i := 162 to 166
  189.             do txt := txt + (chr(disk[blk][i]));
  190.           SetDrMd(ptrRP, 5);
  191.           GrafxText(ptrRP, ^txt, length(txt));
  192.           SetDrMd(ptrRP, 1);
  193.           txt := #$9B + '7m' + txt + #$9B + '0m';
  194.           writeln(txt);
  195.           rowNo := 12;
  196.           lineCnt := 12;
  197.           error := false;
  198.           repeat
  199.             t := disk[blk][0];
  200.             s := disk[blk][1];
  201.             if t <> 0
  202.                 then begin
  203.                   blk := toBlk(t, s);
  204.                   if blk < 0
  205.                       then begin
  206.                         writeln('Track = ', t, ' Sector = ', s, ' is invalid!');
  207.                         t := 0;
  208.                         error := true
  209.                       end
  210.                     else for i := 0 to 7
  211.                            do begin
  212.                              fType := disk[blk][2 + i * 32];
  213.                              if fType <> 0
  214.                                  then begin
  215.                                    size := disk[blk][2 + 29 + i * 32] * 256
  216.                                            + disk[blk][2 + 28 + i * 32];
  217.                                    cnt := intStr(size);
  218.                                    fName := '';
  219.                                    for j := 0 to 15
  220.                                      do begin
  221.                                        byt := disk[blk][2 + 3 + i * 32 + j];
  222.                                        if byt <> 160
  223.                                            then fName := fName + chr(byt)
  224.                                      end;
  225.                                    case fType of
  226.                                        $01: fileT := '*SEQ';
  227.                                        $02: fileT := '*PRG';
  228.                                        $03: fileT := '*USR';
  229.                                        $04: fileT := '*REL';
  230.                                        $80: fileT := ' DEL';
  231.                                        $81: fileT := ' SEQ';
  232.                                        $82: fileT := ' PRG';
  233.                                        $83: fileT := ' USR';
  234.                                        $84: fileT := ' REL';
  235.                                        $C0: fileT := ' DEL<';
  236.                                        $C1: fileT := ' SEQ<';
  237.                                        $C2: fileT := ' PRG<';
  238.                                        $C3: fileT := ' USR<';
  239.                                        $C4: fileT := ' REL<'
  240.                                      else fileT := ' UNK'
  241.                                    end;
  242.                                    txt := cnt
  243.                                           + copy(padding, 1, 5 - length(cnt))
  244.                                           + '"' + fName + '"'
  245.                                           + copy(padding, 1, 16 - length(fName))
  246.                                           + fileT;
  247.                                    if lineCnt mod 24 = 0
  248.                                        then ch := keybdRd;
  249.                                    lineCnt := lineCnt + 1;
  250.                                    if rowNo > 23
  251.                                        then ScrollRaster(ptrRP, 0, 8, 0, 0, 319, 199)
  252.                                      else rowNo := rowNo + 1;
  253.                                    Move(ptrRP, 0, rowNo * 8 + 7);
  254.                                    GrafxText(ptrRP, ^txt, length(txt));
  255.                                    writeln(txt)
  256.                                  end
  257.                             end
  258.                 end
  259.           until t = 0;
  260.           if not error
  261.               then begin
  262.                 blk := toBlk(18, 0);
  263.                 size := 0;
  264.                 for i := 0 to 16
  265.                   do size := size + disk[blk][4 + i * 4];
  266.                 for i := 18 to 34
  267.                   do size := size + disk[blk][4 + i * 4];
  268.                 txt := intStr(size) + ' BLOCKS FREE.';
  269.                 if rowNo > 23
  270.                     then ScrollRaster(ptrRP, 0, 8, 0, 0, 319, 199)
  271.                   else rowNo := rowNo + 1;
  272.                 Move(ptrRP, 0, rowNo * 8 + 7);
  273.                 GrafxText(ptrRP, ^txt, length(txt));
  274.                 writeln(txt)
  275.               end;
  276.           ch := keybdRd;
  277.         end
  278.     end;
  279.   CloseDevice(ptrIOR);
  280.   DeleteIORequest(ptrIOR);
  281.   DeleteMsgPort(ptrMP);
  282.   Close_Window(ptrWin);
  283.   CloseScreen(ptrScr)
  284. end.
  285.