home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / TP-UTIL.ARK / BOXTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1986-01-06  |  3KB  |  95 lines
  1. {-----------------------------}
  2. {           BOXTEST           }
  3. {      by Jeff Duntemann      }
  4. {                             }
  5. {   Character box draw demo   }
  6. {                             }
  7. {      Turbo Pascal V2.0      }
  8. {      Last Update 1/4/85     }
  9. {-----------------------------}
  10.  
  11. PROGRAM BOXTEST;
  12.  
  13. TYPE GRAFREC = RECORD
  14.                  UL_CORNER,
  15.                  UR_CORNER,
  16.                  LL_CORNER,
  17.                  LR_CORNER,
  18.                  H_BAR,
  19.                  V_BAR,
  20.                  LINE_CROSS,
  21.                  T_DOWN,
  22.                  T_UP,
  23.                  T_RIGHT,
  24.                  T_LEFT     : STRING[4]
  25.                END;
  26.  
  27.      STRING80  = STRING[80];
  28.  
  29.  
  30. VAR GRAFCHARS    : GRAFREC;
  31.     X,Y          : INTEGER;
  32.     WIDTH,HEIGHT : INTEGER;
  33.  
  34.  
  35. PROCEDURE DEFINE_CHARS(VAR GRAFCHARS : GRAFREC);
  36.  
  37. BEGIN
  38.   WITH GRAFCHARS DO
  39.     BEGIN
  40.       UL_CORNER := CHR(201);
  41.       UR_CORNER := CHR(187);
  42.       LL_CORNER := CHR(200);
  43.       LR_CORNER := CHR(188);
  44.       H_BAR     := CHR(205);
  45.       V_BAR     := CHR(186);
  46.       LINE_CROSS := CHR(206);
  47.       T_DOWN     := CHR(203);
  48.       T_UP       := CHR(202);
  49.       T_RIGHT    := CHR(185);
  50.       T_LEFT     := CHR(204)
  51.     END
  52. END;
  53.  
  54.  
  55. PROCEDURE MAKE_BOX(X,Y,WIDTH,HEIGHT : INTEGER;
  56.                    GRAFCHARS        : GRAFREC);
  57.  
  58. VAR I,J : INTEGER;
  59.  
  60. BEGIN
  61.   IF X < 0 THEN X := (80-WIDTH) DIV 2;    { Negative X centers box }
  62.   WITH GRAFCHARS DO
  63.     BEGIN                                 { Draw top line }
  64.       GOTOXY(X,Y); WRITE(UL_CORNER);
  65.       FOR I := 3 TO WIDTH DO WRITE(H_BAR);
  66.       WRITE(UR_CORNER);
  67.                                           { Draw bottom line }
  68.       GOTOXY(X,(Y+HEIGHT)-1); WRITE(LL_CORNER);
  69.       FOR I := 3 TO WIDTH DO WRITE(H_BAR);
  70.       WRITE(LR_CORNER);
  71.                                           { Draw sides }
  72.       FOR I := 1 TO HEIGHT-2 DO
  73.         BEGIN
  74.           GOTOXY(X,Y+I); WRITE(V_BAR);
  75.           GOTOXY((X+WIDTH)-1,Y+I); WRITE(V_BAR)
  76.         END
  77.     END
  78. END;
  79.  
  80.  
  81.  
  82. BEGIN
  83.   RANDOMIZE;                 { Seed the pseudorandom number generator }
  84.   CLRSCR;                    { Clear the entire screen }
  85.   DEFINE_CHARS(GRAFCHARS);   { Go get box-draw characters for this machine }
  86.   WHILE NOT KEYPRESSED DO    { Draw boxes until a key is pressed }
  87.     BEGIN
  88.       X := RANDOM(72);       { Get a random X/Y for UL corner of box }
  89.       Y := RANDOM(21);
  90.       REPEAT WIDTH := RANDOM(80-72) UNTIL WIDTH > 1;  { Get random height & }
  91.       REPEAT HEIGHT := RANDOM(25-Y) UNTIL HEIGHT > 1; { width to fit on CRT }
  92.       MAKE_BOX(X,Y,WIDTH,HEIGHT,GRAFCHARS);           { and draw it! }
  93.     END
  94. END.
  95. CR,'L