home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CADKEY_C.ZIP / CADKEY14.ZIP / CDL / SHAPES.CDL < prev    next >
Encoding:
Text File  |  1989-07-13  |  1.8 KB  |  111 lines
  1.  
  2. REM     name:     shapes.cdl
  3.  
  4. REM     date:     010389 simon izraelevitz
  5.  
  6. REM     task:     This program calls cadl programs by indicating 
  7. REM               an icon on the screen.
  8.  
  9. REM     -----------------------------------------------
  10.  
  11. REM  initialize variables
  12.    CLEAR
  13.    hsize   = 6.0
  14.    vsize   = 5.4
  15.    hoffset = 0.25
  16.    voffset = 0.1
  17.    hstart  = 0.0
  18.    vstart  = 0.0
  19.    rows    = 4
  20.    columns = 4
  21.    hinc    = hsize / columns
  22.    vinc    = vsize / rows
  23.    htx     = hinc / 12
  24.    vtx     = vinc / 3
  25.    wx1     = @xmin
  26.    wy1     = @ymin
  27.    wx2     = @xmax
  28.    wy2     = @ymax
  29.    curview = @view
  30.    units   = @units
  31.    set unit, 0
  32.    set view, 1
  33.  
  34. REM  Display shape icon menu and get choice
  35. :dspmenu
  36.    DOSUB sh_scrn.cdl
  37.  
  38. :getmenu
  39.    menopt = 1
  40.    GETPOS "Cursor-indicate CADL program to run", menopt
  41.    IF (@key <= -2)
  42.       GOTO end
  43.    IF (@key != 1)
  44.       GOTO getmenu
  45.    col = floor (@xview / hinc)
  46.    row = floor (@yview / vinc)
  47.  
  48.    ON col GOTO col1,col2,col3,col4,
  49.  
  50. :col1
  51.    ON row GOTO pos11,pos12,pos13,pos14,
  52.  
  53. :col2
  54.    ON row GOTO pos21,pos22,pos23,pos24,
  55.  
  56. :col3
  57.    ON row GOTO pos31,pos32,pos33,pos34,
  58.  
  59. :col4
  60.    ON row GOTO pos41,pos42,pos43,pos44,
  61.  
  62. :pos11
  63.    GOTO open
  64. :pos12
  65.    DOSUB sh_rstr
  66.    CHAIN sh_oval
  67. :pos13
  68.    DOSUB sh_rstr
  69.    CHAIN sh_kout
  70. :pos14
  71.    DOSUB sh_rstr
  72.    CHAIN sh_oslot
  73. :pos21
  74.    GOTO open
  75. :pos22
  76.    GOTO open
  77. :pos23
  78.    DOSUB sh_rstr
  79.    CHAIN sh_kin
  80. :pos24
  81.    DOSUB sh_rstr
  82.    CHAIN sh_rslot
  83. :pos31
  84.    GOTO open
  85. :pos32
  86.    GOTO open
  87. :pos33
  88.    DOSUB sh_rstr
  89.    CHAIN sh_2belt
  90. :pos34
  91.    DOSUB sh_rstr
  92.    CHAIN sh_sslot
  93. :pos41
  94.    GOTO open
  95. :pos42
  96.    GOTO open
  97. :pos43
  98.    GOTO open
  99. :pos44
  100.    DOSUB sh_rstr
  101.    CHAIN sh_raslt
  102.  
  103. :open
  104.    PROMPT "No program is called by this box. Select again."
  105.    WAIT 2
  106.    GOTO getmenu
  107.  
  108. :end
  109.    DOSUB sh_rstr
  110.  
  111.