home *** CD-ROM | disk | FTP | other *** search
/ Die ASC Mega 2 / ASC-Mega2-CD-ROM.iso / SPIELE / KAISER / SCREEN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-08-19  |  1.6 KB  |  54 lines
  1. unit screen;
  2. (* Unit für schnelle Bildschirmausgaben *
  3.  * Oliver Redner, 10.06.1990            *)
  4. {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  5.  
  6.  
  7. interface
  8.  
  9. type  crt_screen_type = array[0..24,0..79,0..1] of char;
  10.       word_screen     = array[0..24,0..79] of word;
  11.       wp              = ^word_screen;
  12.  
  13. const all_single_box  = 0; (* Konstanten für die Prozedur box *)
  14.       all_double_box  = 1;
  15.       hor_single_box  = 2;
  16.       hor_double_box  = 3;
  17.  
  18. var   crt_screen:       ^crt_screen_type;
  19.       crt_mode:         byte absolute $40:$49;
  20.  
  21. procedure box(muster,x_start,y_start,x_lng,y_lng,rand_att,mitt_att: byte);
  22. procedure wr(y,x,att: byte; text: string);
  23. procedure wrm(y,x,att: byte; text: string);
  24. procedure wrr(y,x,att: byte; text: string);
  25. procedure wischen(y,x,anzahl,att: byte);
  26. procedure setattr(y,x,anzahl,att: byte);
  27.  
  28.  
  29. implementation
  30.  
  31. const box_muster: array[0..23] of char =
  32.                     ('┌','─','┐','│','└','┘',
  33.                      '╔','═','╗','║','╚','╝',
  34.                      '╓','─','╖','║','╙','╜',
  35.                      '╒','═','╕','│','╘','╛');
  36.  
  37. {$F+}
  38. procedure box(muster,x_start,y_start,x_lng,y_lng,rand_att,mitt_att: byte);
  39. external; {$L box}
  40.  
  41. procedure wr(y,x,att: byte; text: string); external;
  42. procedure wrm(y,x,att: byte; text: string); external;
  43. procedure wrr(y,x,att: byte; text: string); external; {$L wr}
  44.  
  45. procedure wischen(y,x,anzahl,att: byte); external; {$L wischen}
  46.  
  47. procedure setattr(y,x,anzahl,att: byte); external; {$L setattr}
  48. {$F-}
  49.  
  50.  
  51. begin
  52.   if crt_mode=7 then crt_screen:=ptr($B000,0)
  53.                 else crt_screen:=ptr($B800,0);
  54. end.