home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / program / 167 / pascal / srcnload.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-08-19  |  7.5 KB  |  208 lines
  1. PROCEDURE Make_Path( VAR ps : Path_Name ; VAR cs : Path_Chars ) ;
  2. VAR
  3.    i : Integer ;
  4. BEGIN
  5.    FOR i := 1 TO Length( ps ) DO
  6.    BEGIN
  7.       cs[i] := ps[i] ;
  8.    END ;
  9.       cs[ length(ps)+1 ] := Chr(0) ;
  10. END;
  11.  
  12. { Open an existing file. }
  13. FUNCTION f_open( VAR name : Path_Chars ; mode : Integer ) : Integer ;
  14.   GEMDOS( $3d ) ;
  15. { Mode - 0=read only, 1=write only, 2=reading and writing }
  16.  
  17. { Close an open file. }
  18. FUNCTION f_close( handle : Integer ) : Integer ;
  19.   GEMDOS( $3e ) ;
  20.  
  21. { Read bytes from a file. }
  22. FUNCTION f_read( handle : Integer ; count : Long_Integer ; VAR buf : Pic_Dat
  23. ) : Long_Integer ;
  24.   GEMDOS( $3f ) ;
  25.  
  26. FUNCTION Physbase : S_Ptr;    { xbios routine returns address of screen }
  27.   Xbios( 2 );
  28.  
  29. PROCEDURE Sav_scn;              { proc saves screen to buf }
  30. {$P-}           { turn pointer checking off }
  31.    begin
  32.       Scn_ptr := Physbase;      { get addr of screen in memory }
  33.       Scn_buf := Scn_Ptr^;      { do assignment, copy entire array }
  34.    end;
  35. {$P=}           { restore pointer checking to old state }
  36.  
  37. PROCEDURE Rest_scn;             { restore screen from buf }
  38. {$P-}           { turn pointer checking off }
  39.    begin
  40.       Scn_ptr := Physbase;      { get addr of screen in memory }
  41.       Scn_ptr^ := Scn_buf;      { assign, copy array }
  42.    end;
  43. {$P=}           { set pointer checking to old state }
  44.  
  45. PROCEDURE S_Load;
  46. VAR
  47.    A1, A2, Alert        : Str255 ;
  48.    junk, IO_Handle      : Integer ;
  49.    I, K                 : Integer;       { temporary variable }
  50.    K_Byte               : Byte ;
  51.    Temp                 : Long_Integer;       { one disk file value }
  52.    Name                 : Path_Chars ;
  53. BEGIN
  54.    Make_Path( F_Name, Name );
  55.    IO_Handle := F_Open( Name,2 ) ;
  56.    IF IO_Handle >= 0 THEN
  57.    BEGIN
  58.       Temp := F_Read( IO_Handle,32034,Pic_Buf) ;
  59.    END
  60.    ELSE BEGIN
  61.       Alert :='';
  62.       A1 := 'I could not find data|files DCLOCK.RSC| DCLOCK.RSC must ';
  63.       A2 := 'be|on the same drive and path|as this program!' ;
  64.       Alert :=  concat( '[2][',A1,A2,'][ *NUTS* ]' );
  65.       Junk := Do_Alert( Alert, 0 ) ;
  66.    END;
  67.    Junk := F_Close( IO_Handle ) ;
  68. END;  { of S_Load }
  69.  
  70. PROCEDURE U_Copy( Count : Integer ) ;
  71. VAR
  72.    I, J            : Integer ;
  73. BEGIN
  74.    I := 0 ;
  75.    REPEAT
  76.       J := SHL( I,1 ) ;
  77.       Scn_Buf[ Scn_Buf_Ptr ] := Pic_Buf[ Dat_Ptr + J ] ;
  78.       Scn_Buf[ Scn_Buf_Ptr + 1 ] := Pic_Buf[ Dat_Ptr + J + 1 ] ;
  79.       Scn_Buf_Ptr := Scn_Buf_Ptr + 160 ;
  80.       IF Scn_Buf_Ptr > 32000 THEN
  81.       BEGIN
  82.          Scn_Buf_Ptr := Scn_Buf_Ptr - 31992 ;
  83.          IF Scn_Buf_Ptr > 160 THEN Scn_Buf_Ptr := Scn_Buf_Ptr - 158 ;
  84.       END;
  85.       I := I + 1 ;
  86.    UNTIL I = (Count) ;
  87. END;  { of U_Copy }
  88.  
  89. PROCEDURE Rep_Copy( Count : Integer ) ;
  90. VAR
  91.    I            : Integer ;
  92. BEGIN
  93.    FOR I := 1 TO Count DO
  94.    BEGIN
  95.       Scn_Buf[ Scn_Buf_Ptr ] := Pic_Buf[ Dat_Ptr ] ;
  96.       Scn_Buf[ Scn_Buf_Ptr + 1 ] := Pic_Buf[ Dat_Ptr + 1 ] ;
  97.       Scn_Buf_Ptr := Scn_Buf_Ptr + 160 ;
  98.       IF Scn_Buf_Ptr > 32000 THEN
  99.       BEGIN
  100.          Scn_Buf_Ptr := Scn_Buf_Ptr - 31992 ;
  101.          IF Scn_Buf_Ptr > 160 THEN Scn_Buf_Ptr := Scn_Buf_Ptr - 158 ;
  102.       END;
  103.    END;
  104. END;  { of Rep_Copy }
  105.  
  106.  
  107. PROCEDURE Un_Tiny ;
  108. { this procedure works with the globle variable - Pic_Buf - which contains the
  109.   raw tiny fomat file data read from a disk file. this procedure un-compacts
  110.   data in this file and stores in the globle variable - Scn_Buf - which then
  111.   can be move to screen memory with the procedure Rest_Scn. }
  112. { this procedure also makes calls to U_Copy and Rep_Copy    }
  113.   { Pic_Buf     a place to read picture file data into }
  114.   { Scn_buf     a place to stash the screen }
  115.  
  116. VAR
  117.    Junk         : Integer ;    { for trow away data return by function call }
  118.    I, J, K      : Integer ;    { loop and temp color data }
  119.    Ctl_Cnt      : Integer;     { # of control data bytes }
  120.    Dat_Cnt      : Integer;     { # of pixil data bytes }
  121.    Ctl_Ptr      : Integer ;    { position of next control data }
  122.    Ctl_End      : Integer ;    { end position of control data }
  123.    Dat_End      : Integer ;    { end position of pixil data }
  124.    Temp_Rez     : Byte ;       { read first data value into this variable }
  125.    Temp_Ptr     : Integer ;    { pionter into Pic_Buf }
  126.    Rep_Cnt      : Integer ;    { counter for repeat of pixil data }
  127.    U_Cnt        : Integer ;    { counter for Unique pixil data }
  128. BEGIN
  129.    Scn_Buf_Ptr := 1 ;
  130.    Temp_Rez := Pic_Buf[ 1 ] ;
  131.    { calculate picture file resolution and and if rotation data bytes }
  132.    IF Temp_Rez > 2 THEN Pic_Rez := Temp_Rez - 3 ELSE Pic_Rez := Temp_Rez ;
  133.    If ( Pic_Rez = 0 ) OR ( Pic_Rez = 1 ) THEN  { low or med resolution }
  134.    BEGIN
  135.       IF Temp_Rez > 2 THEN    { find where color data is and copy }
  136.       BEGIN
  137.          FOR I := 0 TO 15 DO
  138.          BEGIN
  139.             K := SHL( Pic_Buf[ (SHL(I,1)+6) ],8 ) ; { get color data }
  140.             Kolor_Reg[ I ] := K + ( Pic_Buf[ (SHL(I,1)+7) ] ) ;
  141.          END;
  142.       END ELSE
  143.       BEGIN
  144.          FOR I := 0 TO 15 DO
  145.          BEGIN
  146.             K := SHL( Pic_Buf[ (SHL(I,1)+2) ],8 ) ; { get color data }
  147.             Kolor_Reg[ I ] := K + ( Pic_Buf[ (SHL(I,1)+3) ] ) ;
  148.          END;
  149.       END;
  150.       Temp_Ptr := 34 ; { piont to ctl_cnt data in Pic_Buf array }
  151.       IF Temp_Rez > 2 THEN Temp_Ptr := 38 ;
  152.          { find number of control bytes }
  153.       Ctl_Cnt := SHL( Pic_Buf[ Temp_Ptr ],8 ) + Pic_Buf[ Temp_Ptr + 1 ] ;
  154.          { find number of pixil data bytes * 2 }
  155.       Dat_Cnt := SHL( Pic_Buf[ Temp_Ptr + 2 ],8 ) + Pic_Buf[ Temp_Ptr + 3 ] ;
  156.          { set control pointer to start of control and pixil data in array }
  157.       Ctl_Ptr := Temp_Ptr + 4 ;
  158.       Dat_Ptr := Ctl_Ptr + Ctl_Cnt ;
  159.          { find end of the 2 data groups, control and pixil }
  160.       Ctl_End := Ctl_Ptr + Ctl_Cnt - 1 ;
  161.       Dat_End := SHL( Dat_Cnt,1 ) + Ctl_End ;
  162.  
  163.       REPEAT
  164.  
  165.          { if control byte is 0 then repeat data times next 2 control bytes }
  166.       IF Pic_Buf[ Ctl_Ptr ] = 0 THEN
  167.       BEGIN
  168.          Temp_Ptr := Ctl_Ptr + 3 ; { find next Ctl_Ptr for next time through }
  169.             { clculate number of repeats }
  170.          Rep_Cnt :=(SHL(Pic_Buf[(Ctl_Ptr+1)],8 ))+( Pic_Buf[(Ctl_Ptr+2)]) ;
  171.          Rep_Copy( Rep_Cnt ) ;
  172.          Dat_Ptr := Dat_Ptr + 2 ;
  173.       END ;
  174.  
  175.          { if control byte is 1<btye<128 then repeat data that many times }
  176.       IF ( Pic_Buf[ Ctl_Ptr ] > 1 ) AND ( Pic_Buf[ Ctl_Ptr ] < 128 ) THEN
  177.       BEGIN
  178.          Temp_Ptr := Ctl_Ptr + 1 ; { find next Ctl_Ptr for next time through }
  179.          Rep_Cnt := Pic_Buf[ Ctl_Ptr ] ;
  180.          Rep_Copy( Rep_Cnt ) ;
  181.          Dat_Ptr := Dat_Ptr + 2 ;
  182.       END;
  183.  
  184.          { If control byte is = 1 then copy consecutive unique data bytes }
  185.       IF Pic_Buf[ Ctl_Ptr ] = 1 THEN
  186.       BEGIN
  187.          Temp_Ptr := Ctl_Ptr + 3 ; { find next Ctl_Ptr for next time through }
  188.             { clculate number of unique bytes }
  189.          U_Cnt :=(SHL(Pic_Buf[(Ctl_Ptr+1)],8))+( Pic_Buf[(Ctl_Ptr+2)]) ;
  190.          U_Copy( U_Cnt ) ;
  191.          Dat_Ptr := Dat_Ptr + U_Cnt * 2 ;
  192.       END;
  193.  
  194.          { if control byte is > 127 copy that many unique data bytes }
  195.       IF ( Pic_Buf[ Ctl_Ptr ] > 127 ) THEN
  196.       BEGIN
  197.          Temp_Ptr := Ctl_Ptr + 1 ; { find next Ctl_Ptr for next time through }
  198.             { clculate number of unique bytes }
  199.          U_Cnt := ( 256 - Pic_Buf[ Ctl_Ptr ] ) ; { make byte positive }
  200.          U_Copy( U_Cnt ) ;
  201.          Dat_Ptr := Dat_Ptr + (SHL(U_Cnt,1)) ;
  202.       END;
  203.       Ctl_Ptr := Temp_Ptr ;
  204.  
  205.       UNTIL ( Ctl_Ptr > Ctl_End ) OR ( Dat_Ptr > Dat_End ) ;
  206.    END;
  207. END;  { of Un_Tiny }
  208.