home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / acc / general / mpaint / mpaint.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1989-01-09  |  44.2 KB  |  1,811 lines
  1. {$a+}
  2. {$U15}
  3. {$P-}
  4. PROGRAM MultiPaint;
  5.  
  6. {$I c:gemsubs.pas}
  7. {$I c:auxsubs.pas}
  8. {$I c:mpaint.i}
  9.  
  10.     mousestate = 79;
  11.     leftbutton = 1;
  12.     rightbutton = 2;
  13.     buttons = 3;
  14.     rightshift = 1;
  15.     leftshift = 2;
  16.     shiftkeys = 3;
  17.     control = 4;
  18.     alternate = 8;
  19.     ShiftAlt = 11;
  20.     ShiftAltCntrl = 14;
  21.     opaque_mode = 1;
  22.     transparent_mode = 2;
  23.     LoadPic = 1;
  24.     SavePic = 2;
  25.     rgbsize = 16;
  26.     Undo = $6100;
  27.     Help = $6200;
  28.     Escape = $011B;
  29.     Tab = $0F09;
  30.     Backspace = $0E08;
  31.     F1 = $3B00;
  32.     F2 = $3C00;
  33.     PicBeg = 1;
  34.     PicEnd = 32256;  { integer array }
  35.  
  36.   TYPE
  37.     modetype = draw .. text;
  38.     drawmodetype = 1 .. 2;
  39.     MFDBtype = PACKED ARRAY [ 1 .. 76 ] OF byte;
  40.     picType = PACKED ARRAY [ PicBeg .. PicEnd ] OF byte ;
  41.     RGBtype = PACKED ARRAY [ 0 .. 15 ] OF 
  42.               PACKED ARRAY [ 1 .. 3  ] OF integer;
  43.     SliderType = RECORD
  44.                   x_inc,y_inc,
  45.                   x_size,y_size,
  46.                   x_limit,y_limit,
  47.                   x_offset,y_offset,
  48.                   x_slide,y_slide,h_slide,v_slide : integer
  49.                  END;
  50.     
  51.   VAR
  52.     ctrl : Ctrl_Parms;
  53.     int_in : Int_In_Parms;
  54.     int_out : Int_Out_Parms;
  55.     pts_in : Pts_In_Parms;
  56.     pts_out : Pts_Out_Parms;
  57.     addr_in : Addr_In_Parms;
  58.     addr_out : Addr_Out_Parms;
  59.  
  60.     title,info : Window_Title;
  61.     msg : Message_Buffer;
  62.     RGB : RGBtype;
  63.     pic : picType;
  64.     deskcolors,sketchcolors : Palette;   
  65.     path : Path_Name;
  66.     c_name : C_String;
  67.     p_name : Str255;
  68.     resource : String[9];
  69.     drawmode : drawmodetype;
  70.     mode : modetype;
  71.     dialog1_ptr,dialog2_ptr : Dialog_Ptr;
  72.     desk_name : Str255;
  73.     mag,wind : SliderType;
  74.     MFDB : MFDBtype;
  75.     picture,pic_start,screen,saturation,coverage,
  76.     oldmouse,newmouse,MFDBptr : long_integer;
  77.     x,y,w,h,
  78.     gzz_x,gzz_y,gzz_w,gzz_h,
  79.     bit_w,bit_h,xmax,ymax,bottomedge,rightedge,
  80.     window,
  81.     bitplanes,byteplanes,nextplane,rowsize,bitsize,aspect,
  82.     paintstyle,XBIOScolor,rez,blitmode,
  83.     dummy,event,
  84.     keystate,key,mx,my,
  85.     Fx,Ox,FOwidth1,FOwidth2,FOxoffset,FOyoffset,
  86.     origx,origy,
  87.     brushwidth,brusheight,textsize,
  88.     radius,palettesize,linestyle,
  89.     inkwellcolor,inkwellspot,inkwell_width,inkwell_height,
  90.     menubar,patternspot,
  91.     ap_id,menu_id : integer;
  92.  
  93.    FUNCTION Addr_Palette( VAR Pal_array : Palette ) : long_integer;
  94.     FUNCTION Addr( VAR Pal_array : Palette ) : long_integer;
  95.      EXTERNAL;
  96.     BEGIN
  97.      Addr_Palette := Addr( Pal_array )
  98.     END;
  99.  
  100.   PROCEDURE Blit( MFDBptr : long_integer );
  101.    C;
  102.  
  103.   FUNCTION InitVec( ymin : integer; oldvec : long_integer ) : long_integer;
  104.    C;
  105.    
  106.   FUNCTION DumVec : long_integer;
  107.    C;
  108.    
  109.   FUNCTION Drive : integer;
  110.    gemdos( $19 );
  111.  
  112.   FUNCTION F_Create( VAR string : C_String;
  113.                      attributes : integer ) : integer;
  114.    gemdos( $3C );        
  115.  
  116.   FUNCTION F_Close( handle : integer ) : integer;
  117.    gemdos( $3E );
  118.  
  119.   FUNCTION F_Read( handle : integer; count  : long_integer;
  120.                    picture : long_integer ) : long_integer;
  121.    gemdos( $3F );
  122.    
  123.   FUNCTION F_Write( handle : integer; count  : long_integer;
  124.                     picture : long_integer ) : long_integer;
  125.    gemdos( $40 );
  126.    
  127.   FUNCTION F_Seek( offset : long_integer;  
  128.                    handle,mode : integer ) : long_integer;
  129.    gemdos( $42 );
  130.    
  131.   PROCEDURE GetDir( VAR path : C_String;  drive : integer );
  132.    gemdos( $47 );
  133.    
  134.   FUNCTION Physbase : long_integer;
  135.    XBIOS( 2 );
  136.  
  137.   FUNCTION Logbase : long_integer;
  138.    XBIOS( 3 );
  139.  
  140.   FUNCTION getrez : integer;
  141.    XBIOS( 4 );
  142.  
  143.   PROCEDURE SetScreen( log,phys : long_integer;  rez : integer );  
  144.    XBIOS( 5 );
  145.  
  146.   PROCEDURE SetPalette( pal_ptr : long_integer );
  147.    XBIOS( 6 );
  148.  
  149.   FUNCTION SetGetColor( coloreg,color : integer ) : integer;
  150.    XBIOS( 7 );
  151.  
  152.   FUNCTION random : long_integer;
  153.    XBIOS( 17 );
  154.  
  155.   PROCEDURE MouseVector( newvector : long_integer; 
  156.                          VAR oldvector : long_integer );
  157.    TYPE
  158.     Ctrl_Parms = RECORD
  159.                   c6,c5,c4,c3,c2,c1,c0 : integer;
  160.                   newvec : long_integer;
  161.                   oldvec : long_integer
  162.                  END;
  163.    VAR
  164.     ctrl : Ctrl_Parms;
  165.     
  166.    PROCEDURE VDI_Call( cmd,sub_cmd,nints,npts : integer;
  167.                        VAR ctrl    : Ctrl_Parms;
  168.                        VAR int_in  : Int_In_Parms;
  169.                        VAR int_out : Int_Out_Parms;
  170.                        VAR pts_in  : Pts_In_Parms;
  171.                        VAR pts_out : Pts_Out_Parms;
  172.                        translate   : boolean );
  173.       EXTERNAL ;
  174.    BEGIN
  175.     ctrl.newvec := newvector;
  176.     VDI_Call( 126,0,0,0,ctrl,int_in,int_out,pts_in,pts_out,FALSE );
  177.     oldvector := ctrl.oldvec
  178.    END;
  179.  
  180.   FUNCTION Pixel( xpos,ypos : integer ) : integer;
  181.    BEGIN
  182.     pts_in[0] := xpos;
  183.     pts_in[1] := ypos;
  184.     VDI_Call( 105,0,0,2,ctrl,int_in,int_out,pts_in,pts_out,FALSE );
  185.     Pixel := int_out[0]
  186.    END;
  187.    
  188.    PROCEDURE Line_Width( size : integer );
  189.     BEGIN
  190.      pts_in[0] := size;
  191.      pts_in[1] := 0;
  192.      VDI_Call( 16,0,0,2,ctrl,int_in,int_out,pts_in,pts_out,FALSE )
  193.     END;
  194.  
  195.   FUNCTION GemToXbios( reg : integer ) : integer;
  196.    BEGIN
  197.     CASE reg OF
  198.      1:
  199.       CASE rez OF
  200.        0: GemToXbios := 15;
  201.        1: GemToXbios := 3;
  202.        2: GemToXbios := reg 
  203.       END;
  204.      2,3,8,9,10,11:
  205.            GemToXbios := reg-1;
  206.      7,15: GemToXbios := reg-2;
  207.      6,14: GemToXbios := reg-3;
  208.      5,13: GemToXbios := reg+1;
  209.      OTHERWISE:
  210.            GemToXbios := reg
  211.     END
  212.    END;
  213.  
  214.   FUNCTION XbiosToGem( reg : integer ) : integer;
  215.    BEGIN
  216.     CASE reg OF
  217.      15:   XbiosToGem := 1;
  218.      1,2,7,8,9,10:
  219.            XbiosToGem := reg+1;
  220.      5,13: XbiosToGem := reg+2;
  221.      3,11:
  222.       IF rez = 1 THEN
  223.        XbiosToGem := 1
  224.       ELSE
  225.        XbiosToGem := reg+3;
  226.      6,14: XbiosToGem := reg-1;
  227.      OTHERWISE:
  228.            XbiosToGem := reg
  229.     END
  230.    END;
  231.  
  232.   PROCEDURE StoreColors;
  233.    CONST
  234.     Red = 1792;  Green = 112;  Blue = 7;
  235.    VAR
  236.     i,col : integer;
  237.    BEGIN
  238.     FOR i := 0 TO 15 DO
  239.      BEGIN
  240.       col := SetGetColor( GemToXbios( i ),-1 );
  241.       RGB[i][1] := ( col & Red   ) DIV 256;
  242.       RGB[i][2] := ( col & Green ) DIV 16;
  243.       RGB[i][3] :=   col & Blue
  244.      END
  245.    END;
  246.  
  247.   PROCEDURE Delay( duration : long_integer );
  248.    BEGIN
  249.     dummy := Get_Event( E_Timer,
  250.                         0,0,0,duration,FALSE,0,0,0,0,FALSE,0,0,0,0,
  251.                         msg,dummy,dummy,dummy,dummy,dummy,dummy )
  252.    END;
  253.  
  254.   PROCEDURE LoadError;
  255.    BEGIN
  256.     dummy :=
  257.      Do_Alert('[3][ | |Load Error!| | ][ Understood ]',1 )
  258.    END;
  259.     
  260.   PROCEDURE SaveError;
  261.    BEGIN
  262.     dummy :=
  263.      Do_Alert('[3][ | |Save Error!| | ][ Understood ]',1 )
  264.    END;
  265.     
  266.   PROCEDURE GetColors( VAR col : Palette );
  267.    VAR
  268.     i : integer;
  269.    BEGIN 
  270.     FOR i := 0 TO 15 DO
  271.      col[i] := SetGetColor( i,-1 )
  272.    END;
  273.    
  274.   PROCEDURE SavePalette;
  275.    BEGIN
  276.     GetColors( sketchcolors );
  277.     StoreColors
  278.    END;
  279.    
  280.   PROCEDURE ClipWindow( VAR xpos,ypos,width,height : integer );
  281.    BEGIN
  282.     Work_Rect( window,xpos,ypos,width,height );
  283.     gzz_x := xpos;
  284.     gzz_y := ypos+inkwell_height+3;
  285.     gzz_w := width;
  286.     gzz_h := height-inkwell_height-3;
  287.     rightedge := gzz_x+gzz_w-1;
  288.     bottomedge := gzz_y+gzz_h-1;
  289.     Fx := rightedge-FOwidth2+1;
  290.     Ox := rightedge-FOwidth1+1;
  291.     inkwellspot := xpos+( inkwellcolor*inkwell_width );
  292.     WITH wind DO
  293.      BEGIN
  294.       x_size  := SHORT_TRUNC(( gzz_w / xmax ) * 1000 );
  295.       y_size  := SHORT_TRUNC(( gzz_h / ymax ) * 1000 );
  296.       x_limit := ( xmax-gzz_w )+1;
  297.       y_limit := ( ymax-gzz_h )+1;
  298.       x_slide := SHORT_TRUNC( 1000 / x_limit ) * x_inc; 
  299.       y_slide := SHORT_TRUNC( 1000 / y_limit ) * y_inc
  300.      END;
  301.     Set_Clip( gzz_x,gzz_y,gzz_w,gzz_h )
  302.    END; 
  303.    
  304.   FUNCTION Click( mask : integer ) : boolean;
  305.    BEGIN
  306.     AES_Call( mousestate,int_in,int_out,addr_in,addr_out );
  307.     Click := int_out[3] & mask <> 0
  308.    END;
  309.    
  310.   FUNCTION ButtonDown( VAR newx,newy : integer ) : boolean;
  311.    BEGIN
  312.     event := Get_Event( E_Message | E_Button | E_Timer,
  313.                         1,1,1,0,FALSE,0,0,0,0,FALSE,0,0,0,0,
  314.                         msg,dummy,dummy,dummy,newx,newy,dummy );
  315.     ButtonDown := event & E_Button <> 0                   
  316.    END;
  317.  
  318.   PROCEDURE Limit( VAR position : integer;  min,max : integer );
  319.    BEGIN
  320.     IF position < min THEN  position := min;
  321.     IF position > max THEN  position := max
  322.    END;
  323.    
  324.   PROCEDURE RubberBox( keystate,mx,my,xmin,ymin,xmax,ymax : integer;
  325.                        VAR width,height : integer );
  326.    VAR
  327.     newx,newy : integer;
  328.    BEGIN
  329.     Hide_Mouse;
  330.     Draw_Mode( 3 );
  331.     Line_Color( 1 );
  332.     Line_Style( 1 );
  333.     IF ( mode = box ) OR ( mode = block ) THEN  Line_Width( 1 );
  334.     WHILE ButtonDown( newx,newy ) DO
  335.      BEGIN
  336.       Limit( newx,xmin,xmax );
  337.       Limit( newy,ymin,ymax );
  338.       width := ABS( newx-mx );
  339.       IF keystate & shiftkeys <> 0 THEN
  340.        height := width DIV aspect
  341.       ELSE
  342.        height := ABS( newy-my ); 
  343.       Frame_Rect( mx,my,width,height );
  344.       Delay( 25 );
  345.       Frame_Rect( mx,my,width,height )
  346.      END
  347.    END;
  348.  
  349. PROCEDURE ModeInfo;
  350.  BEGIN
  351.   CASE mode OF
  352.    draw:
  353.     info := ' DRAW';
  354.    magnify:
  355.     info := ' MAGNIFY';
  356.    circle:
  357.     info := ' CIRCLE';
  358.    disc:
  359.     info := ' DISC';
  360.    frame:
  361.     info := ' FRAME';
  362.    box:
  363.     info := ' BOX';
  364.    airbrush:
  365.     info := ' AIRBRUSH';
  366.    lines:
  367.     info := ' LINE';
  368.    block:
  369.     info := ' COPY';
  370.    pal:
  371.     info := ' PALETTE';
  372.    fill:
  373.     info := ' FILL';
  374.    text:
  375.     info := ' TEXT' 
  376.   END
  377.  END;
  378.  
  379.  PROCEDURE ChangeInfo;
  380.   BEGIN
  381.    info := '';
  382.    Set_Winfo( window,info );
  383.    ModeInfo;
  384.    Set_Winfo( window,info )
  385.   END;
  386.  
  387.   PROCEDURE Attributes;
  388.    BEGIN
  389.     Paint_Style( paintstyle );
  390.     Paint_Color( XBIOScolor );
  391.     Line_Color( XBIOScolor );
  392.     Line_Style( linestyle );
  393.     Line_Width( brushwidth );
  394.     Draw_Mode( drawmode );
  395.     Text_Color( XBIOScolor );
  396.     Text_Style( Normal );
  397.     Text_Height( textsize )
  398.    END;
  399.   
  400.   PROCEDURE CopyRaster( source,destination : long_integer;
  401.                         src_xorigin,src_yorigin,dest_xorigin,dest_yorigin,
  402.                         dest_x,dest_y,width,height,mode : integer );
  403.  
  404.    PROCEDURE DoBlit( src_ptr,dest_ptr : long_integer;
  405.                      src_x,src_y,s_nextplane,d_nextplane,copymode :integer);
  406.     BEGIN
  407.      WPOKE( MFDBptr,width );
  408.      WPOKE( MFDBptr+2,height );
  409.      WPOKE( MFDBptr+4,bitplanes );
  410.      POKE( MFDBptr+10,copymode );
  411.      POKE( MFDBptr+11,copymode );
  412.      POKE( MFDBptr+12,copymode );
  413.      POKE( MFDBptr+13,copymode );
  414.      WPOKE( MFDBptr+14,src_x );
  415.      WPOKE( MFDBptr+16,src_y );
  416.      LPOKE( MFDBptr+18,src_ptr );
  417.      WPOKE( MFDBptr+26,s_nextplane );
  418.      WPOKE( MFDBptr+28,dest_x );
  419.      WPOKE( MFDBptr+30,dest_y );
  420.      LPOKE( MFDBptr+32,dest_ptr );
  421.      WPOKE( MFDBptr+40,d_nextplane );
  422.      Blit( MFDBptr )
  423.     END;
  424.     
  425.    BEGIN
  426.     Hide_Mouse;
  427.     IF mode = 7 THEN
  428.      BEGIN
  429.       { 1. Clear dest
  430.         2. Combine source and dest into one plane
  431.         3. Unroll dest into multiple planes
  432.         4. Source AND ( NOT dest )                  }
  433.       DoBlit( source,destination,src_xorigin,src_yorigin,
  434.               nextplane,nextplane,0 );
  435.       DoBlit( source,destination,src_xorigin,src_yorigin,nextplane,0,7 );
  436.       DoBlit( destination,destination,dest_x,dest_y,0,nextplane,7 );
  437.       DoBlit( source,destination,dest_xorigin,dest_yorigin,
  438.               nextplane,nextplane,2 )
  439.      END;
  440.     DoBlit( source,destination,src_xorigin,src_yorigin,
  441.             nextplane,nextplane,mode );
  442.     Show_Mouse
  443.    END;
  444.   
  445.   PROCEDURE Blit_to_Screen;
  446.    BEGIN
  447.     screen := Physbase;
  448.     CASE mode OF
  449.      magnify,pal:  ;
  450.      OTHERWISE:
  451.       CopyRaster( picture,screen,wind.x_offset,wind.y_offset,0,0,
  452.                   gzz_x,gzz_y,gzz_w,gzz_h,3 )
  453.     END
  454.    END;
  455.       
  456.   PROCEDURE Blit_to_Memory;
  457.    BEGIN
  458.     screen := Physbase;
  459.     CASE mode OF
  460.      magnify:  ;
  461.      pal:
  462.       SavePalette;
  463.      OTHERWISE:
  464.       CopyRaster( screen,picture,gzz_x,gzz_y,0,0,
  465.                   wind.x_offset,wind.y_offset,gzz_w,gzz_h,3 )
  466.     END
  467.    END;
  468.  
  469.   PROCEDURE ClearPic;
  470.    VAR
  471.     i : integer;
  472.    BEGIN
  473.     FOR i := PicBeg TO PicEnd DO
  474.      pic[i] := 0
  475.    END;
  476.    
  477.   PROCEDURE SetVariables;
  478.    VAR
  479.     i : integer;
  480.  
  481.    FUNCTION Addr_Pic( VAR Screen_pic : picType ) : long_integer;
  482.     FUNCTION Addr( VAR Screen_pic : picType ) : long_integer;
  483.      EXTERNAL;
  484.     BEGIN
  485.      Addr_Pic := Addr( Screen_pic )
  486.     END;
  487.    
  488.    FUNCTION Addr_MFDB( VAR MFDB : MFDBtype ) : long_integer;
  489.     FUNCTION Addr( VAR MFDB : MFDBtype ) : long_integer;
  490.      EXTERNAL;
  491.     BEGIN
  492.      Addr_MFDB := Addr( MFDB )
  493.     END;
  494.  
  495.    BEGIN
  496.     inkwellcolor := 1;
  497.     XBIOScolor := XbiosToGem( inkwellcolor );
  498.     paintstyle := 1;
  499.     linestyle := 1;
  500.     brushwidth := 1;
  501.     textsize := 3;
  502.     bitsize := 5;
  503.     patternspot := ( inkwell_width*palettesize )+1;
  504.     drawmode := transparent_mode;
  505.     blitmode := 7;
  506.     mode := draw;
  507.     saturation := 35;
  508.     coverage := 15;
  509.     pic_start := Addr_Pic( pic );
  510.     MFDBptr := Addr_MFDB( MFDB );
  511.     picture := (( pic_start DIV 256 ) * 256 ) + 256;
  512.     GetDir( c_name,Drive );
  513.     C_TO_PSTR( c_name,p_name );
  514.     path := CONCAT( CHR( $41+Drive ),':',p_name,'\*.*' ); 
  515.     p_name := '';
  516.     WPOKE( MFDBptr+6,1 );
  517.     WPOKE( MFDBptr+8,0 );
  518.     WPOKE( MFDBptr+22,byteplanes );
  519.     WPOKE( MFDBptr+24,rowsize );
  520.     WPOKE( MFDBptr+36,byteplanes );
  521.     WPOKE( MFDBptr+38,rowsize );
  522.     LPOKE( MFDBptr+42,0 );
  523.     WPOKE( MFDBptr+46,0 );
  524.     WPOKE( MFDBptr+48,0 );
  525.     WPOKE( MFDBptr+50,0 );
  526.     FOR i := 52 TO 75 DO
  527.      POKE( MFDBptr+i,0 );
  528.     WITH wind DO
  529.      BEGIN
  530.       h_slide := 1;
  531.       v_slide := 1;
  532.       x_offset := 0;
  533.       y_offset := 0;
  534.       x_inc := 8;
  535.       y_inc := 10;
  536.       x_size := -1;
  537.       y_size := -1
  538.      END;
  539.     mag := wind;
  540.     mag.x_inc := 1;
  541.     mag.y_inc := 1
  542.   END;
  543.  
  544.   PROCEDURE GetResolution;
  545.    BEGIN
  546.     rez := getrez;
  547.     CASE rez OF
  548.      0:                    { low-res }
  549.       BEGIN
  550.        xmax := 319;
  551.        ymax := 199;
  552.        menubar := 12;
  553.        bitplanes := 4;
  554.        nextplane := 2;
  555.        aspect := 1;
  556.        rowsize := 160;
  557.        palettesize := 16;
  558.        FOwidth1 := 19;
  559.        FOwidth2 := 38;
  560.        FOxoffset := 1;
  561.        FOyoffset := 17;
  562.        inkwell_width := 12;
  563.        inkwell_height := 20
  564.       END;
  565.  
  566.      1:                    { medium-res }
  567.       BEGIN
  568.        xmax := 639;
  569.        ymax := 199;
  570.        menubar := 12;
  571.        bitplanes := 2;
  572.        nextplane := 2;
  573.        aspect := 2;
  574.        rowsize := 160;
  575.        palettesize := 4;
  576.        FOwidth1 := 34;
  577.        FOwidth2 := 68;
  578.        FOxoffset := 8;
  579.        FOyoffset := 17;
  580.        inkwell_width := 64;
  581.        inkwell_height := 20
  582.       END;
  583.  
  584.      2:    
  585.       BEGIN               { high-res }
  586.        xmax := 639;
  587.        ymax := 399;
  588.        menubar := 20;
  589.        bitplanes := 1;
  590.        nextplane := 0;
  591.        aspect := 1;
  592.        rowsize := 80;
  593.        palettesize := 2;
  594.        FOwidth1 := 34;
  595.        FOwidth2 := 68;
  596.        FOxoffset := 8;
  597.        FOyoffset := 32;
  598.        inkwell_width := 128;
  599.        inkwell_height := 40
  600.       END
  601.     END;
  602.     byteplanes := bitplanes * 2
  603.   END;
  604.   
  605.   PROCEDURE Initialize;
  606.    BEGIN
  607.     GetResolution;
  608.     SetVariables;
  609.     GetColors( deskcolors );
  610.     SavePalette;
  611.     ClearPic;
  612.     title := ' MultiPaint ';
  613.     IO_Check( FALSE );
  614.     Attributes
  615.    END;
  616.  
  617.   PROCEDURE DrawPatternBox;
  618.    BEGIN
  619.     Paint_Outline( TRUE );
  620.     Paint_Color( 1 );
  621.     Paint_Style( paintstyle );
  622.     Draw_Mode( 1 );
  623.     Paint_Rect( x+patternspot,y+1,w-patternspot-FOwidth2-1,inkwell_height )
  624.    END;
  625.  
  626.   PROCEDURE ClearWindow;
  627.    BEGIN
  628.     Hide_Mouse;
  629.     Paint_Color( 0 );
  630.     Paint_Style( 1 );
  631.     Paint_Rect( x,y,w,h );
  632.     Attributes;
  633.     Show_Mouse
  634.    END;
  635.  
  636.   PROCEDURE DoPaint( xpos,ypos : integer );
  637.    BEGIN
  638.     Hide_Mouse;
  639.     int_in[0] := -1;
  640.     pts_in[0] := xpos;
  641.     pts_in[1] := ypos;
  642.     VDI_Call( 103,0,1,2,ctrl,int_in,int_out,pts_in,pts_out,FALSE );
  643.     Show_Mouse
  644.    END;
  645.  
  646.   PROCEDURE FatBits;
  647.    VAR
  648.     i,j,row_pos,row,fatsize : integer;
  649.     log : long_integer;
  650.    BEGIN
  651.     Paint_Outline( TRUE );
  652.     Paint_Style( 1 );
  653.     Line_Color( 1 );
  654.     Line_Style( 1 );
  655.     Line_Width( 1 );
  656.     log := Logbase;
  657.     fatsize := bitsize-1;
  658.     Hide_Mouse;
  659.     info := ' Wait ...';
  660.     Set_Winfo( window,info );
  661.     Frame_Rect( gzz_x-1,gzz_y-1,
  662.               ( bitsize*( bit_w+1 ))+1,( bitsize*( bit_h+1 ))+1 );
  663.     WITH mag DO
  664.      BEGIN
  665.       FOR j := 0 TO bit_h DO
  666.        BEGIN
  667.         row := y_offset+j;
  668.         row_pos := gzz_y+( j*bitsize );
  669.         FOR i := 0 TO bit_w DO
  670.          BEGIN
  671.           SetScreen( picture,-1,-1 );
  672.           IF Pixel( x_offset+i,row ) <> 0 THEN
  673.            BEGIN
  674.             Paint_Color( int_out[1] );
  675.             SetScreen( log,-1,-1 );
  676.             Paint_Rect( gzz_x+( i*bitsize ),row_pos,fatsize,fatsize )
  677.            END
  678.          END
  679.        END
  680.      END;
  681.     SetScreen( log,-1,-1 );
  682.     ChangeInfo;
  683.     Show_Mouse;
  684.     Attributes
  685.    END; 
  686.  
  687.   PROCEDURE ColorPanel;
  688.    CONST
  689.     RGBcenter = 12;
  690.    VAR
  691.     RGBchar : ARRAY [ 1 .. 3 ] OF char;
  692.     i,j,intensity,xpos,ypos,left,right : integer;
  693.    BEGIN
  694.     Hide_Mouse;
  695.     Text_Color( 1 );
  696.     Line_Color( 1 );
  697.     Paint_Color( 1 );
  698.     Line_Style( 1 );
  699.     Line_Width( 1 );
  700.     Paint_Style( 1 );
  701.     Text_Style( Normal );
  702.     Text_Height( 8 );
  703.     Paint_Outline( TRUE );
  704.     RGBchar[1] := 'R';
  705.     RGBchar[2] := 'G';
  706.     RGBchar[3] := 'B';
  707.     left := gzz_x+( rgbsize DIV 4 );
  708.     right := left+( rgbsize * 9 );
  709.     FOR j := 1 TO 3 DO
  710.      BEGIN
  711.       ypos := gzz_y+(( j-1 )*rgbsize );
  712.       intensity := RGB[XBIOScolor][j]+1;
  713.       FOR i := 0 TO 9 DO
  714.        BEGIN
  715.         xpos := gzz_x+( i*rgbsize );
  716.         IF intensity = i THEN
  717.          Paint_Rect( xpos,ypos,rgbsize,rgbsize )
  718.         ELSE
  719.          Frame_Rect( xpos,ypos,rgbsize,rgbsize )
  720.        END;
  721.       ypos := ypos+RGBcenter;
  722.       Draw_String( left,ypos,RGBchar[j] );      
  723.       Draw_String( right,ypos,RGBchar[j] );
  724.      END;
  725.     Attributes;
  726.     Show_Mouse
  727.    END;
  728.  
  729.   PROCEDURE DrawScreen;
  730.    VAR
  731.     i,ypos : integer;
  732.    BEGIN
  733.     ClearWindow;
  734.     Paint_Style( 1 );
  735.     Line_Color( 1 );
  736.     Line_Style( 1 );
  737.     Line_Width( 1 );
  738.     Text_Color( 1 );
  739.     Text_Style( Outlined );
  740.     IF rez = 2 THEN
  741.      Text_Height( 26 )
  742.     ELSE
  743.      Text_Height( 12 );
  744.     FOR i := 1 TO palettesize-1 DO
  745.      BEGIN
  746.       Paint_Color( XbiosToGem( i ));
  747.       Paint_Rect( x+( i*inkwell_width ),y+1,inkwell_width,inkwell_height )
  748.      END;
  749.     Frame_Rect( x,y+1,inkwell_width,inkwell_height );
  750.     Frame_Rect( inkwellspot,y,inkwell_width,inkwell_height+2 );
  751.     ypos := gzz_y-1;
  752.     Line( gzz_x,ypos,gzz_x+gzz_w,ypos );
  753.     Draw_Mode( 2 );
  754.     Frame_Rect( Fx,y+1,FOwidth1-1,inkwell_height );
  755.     Frame_Rect( Ox,y+1,FOwidth1-1,inkwell_height );
  756.     Draw_String( Fx+FOxoffset,y+FOyoffset,'F' );
  757.     Draw_String( Ox+FOxoffset,y+FOyoffset,'O' );
  758.     DrawPatternBox;
  759.     Attributes;
  760.     CASE mode OF
  761.      magnify:   FatBits;
  762.      pal:       ColorPanel;
  763.      OTHERWISE: Blit_to_Screen
  764.     END
  765.    END;
  766.    
  767.   PROCEDURE Redraw;
  768.    BEGIN
  769.     Begin_Update;
  770.     Hide_Mouse;
  771.     Set_Clip( x,y,w,h );
  772.     DrawScreen;
  773.     Set_Clip( gzz_x,gzz_y,gzz_w,gzz_h );
  774.     Show_Mouse;
  775.     End_Update
  776.    END;
  777.  
  778.  FUNCTION Slider( slide,limit,WF_Flag : integer ) : integer;
  779.   BEGIN
  780.    Slider := SHORT_TRUNC(( slide / 1000 ) * limit );
  781.    Wind_Set( window,WF_Flag,slide,0,0,0 )
  782.   END;
  783.  
  784.  PROCEDURE ScrollBars;
  785.  
  786.   PROCEDURE SetSliders( h_slide,v_slide,x_size,y_size : integer );
  787.    BEGIN
  788.     Wind_Set( window,WF_HSlide,h_slide,0,0,0 );
  789.     Wind_Set( window,WF_VSlide,v_slide,0,0,0 );
  790.     Wind_Set( window,WF_HSlSize,x_size,0,0,0 );
  791.     Wind_Set( window,WF_VSlSize,y_size,0,0,0 )
  792.    END;
  793.    
  794.   BEGIN
  795.    CASE mode OF
  796.     magnify:
  797.      WITH mag DO
  798.       BEGIN
  799.        bit_w := ( gzz_w DIV bitsize )-1;
  800.        bit_h := ( gzz_h DIV bitsize )-1;
  801.        x_limit := xmax-bit_w;
  802.        y_limit := ymax-bit_h;
  803.        x_slide := SHORT_ROUND( 1000 / ( x_limit+1 )); 
  804.        y_slide := SHORT_ROUND( 1000 / ( y_limit+1 ));
  805.        x_offset := Slider( h_slide,x_limit,WF_HSlide );
  806.        y_offset := Slider( v_slide,y_limit,WF_VSlide );
  807.        SetSliders( h_slide,v_slide,x_size,y_size )
  808.       END;
  809.     pal:  ;
  810.     OTHERWISE:
  811.      WITH wind DO
  812.       SetSliders( h_slide,v_slide,x_size,y_size )
  813.    END
  814.   END;
  815.  
  816.  FUNCTION EventMulti : integer;
  817.   BEGIN
  818.    EventMulti := Get_Event( E_Message | E_Keyboard | E_Button |
  819.                             E_Timer | E_MRect_1,
  820.                             1,1,1,0,FALSE,x,y,w,h,TRUE,0,0,0,0,
  821.                             msg,key,dummy,dummy,mx,my,keystate )
  822.   END;
  823.  
  824.  PROCEDURE BlockCopy( keystate,xpos,ypos : integer );
  825.   VAR
  826.    key,origx,origy,newx,newy,width,height,xorigin,yorigin : integer;
  827.    Move : boolean;
  828.  
  829.   PROCEDURE TrapBlit( VAR xpos,ypos : integer );
  830.    BEGIN
  831.     Limit( xpos,gzz_x,rightedge-width+1 );
  832.     Limit( ypos,gzz_y,bottomedge-height+1 );
  833.    END;
  834.  
  835.   PROCEDURE BlitToOrigin;
  836.    ^DGIN
  837.     CopyRaster( picture,screen,
  838.                 xorigin,yorigin,0,0,origx,origy,width,height,6 )
  839.    END;
  840.  
  841.   PROCEDURE BlitToMouse( mode : integer );
  842.    BEGIN
  843.     CopyRaster( picture,screen,xorigin,yorigin,
  844.                 wind.x_offset+newx-gzz_x,wind.y_offset+newy-gzz_y,
  845.                 newx,newy,width,height,mode )
  846.    END;
  847.    
  848.   BEGIN
  849.    Blit_to_Memory;
  850.    Limit( xpimit( xpimit( xpimit( xpimit( xp );
  851.     LPOKE( MFDBptr+42,0 );
  852.     WPOKE( MFDBptr+46,0 );
  853.     WPOKE( MFDBptr+48,0 );
  854.     WPOKE( MFDBptr+50,0 );
  855.     FOR i := 52 TO 75 DO
  856.      POKE( MFDBptr+i,0 );
  857.     WITH wind DO
  858.      BEGIN
  859.       h_slide := 1;
  860.       v_slide := 1;
  861.       x_offset := 0;
  862.       y_offset := 0;
  863.       x_inc := 8;
  864.       y_inc := 10;
  865.       x_size := -1;
  866.       y_size := -1
  867.      END;
  868.     mag := wind;
  869.     mag.x_inc := 1;
  870.     mag.y_inc := 1
  871.   END;
  872.  
  873.   PROCEDURE GetResolution;
  874.    BEGIN
  875.     rez := getrez;
  876.     CASE rez OF
  877.      0:                    { low-res }
  878.       BEGIN
  879.        xmax := 319;
  880.        ymax := 199;
  881.        menubar := 12;
  882.        bitplanes := 4;
  883.        nextplane := 2;
  884.        aspect := 1;
  885.        rowsize := 160;
  886.        palettesize := 16;
  887.        FOwidth1 := 19;
  888.        FOwidth2 := 38;
  889.        FOxoffset := 1;
  890.        FOyoffset := 17;
  891.        inkwell_width := 12;
  892.        inkwell_height := 20
  893.       END;
  894.  
  895.      1:                    { medium-res }
  896.       BEGIN
  897.        xmax := 639;
  898.        ymax := 199;
  899.        menubar := 12;
  900.        bitplanes := 2;
  901.        nextplane := 2;
  902.        aspect := 2;
  903.        rowsize := 160;
  904.        palettesize := 4;
  905.        FOwidth1 := 34;
  906.        FOwidth2 := 68;
  907.        FOxoffset := 8;
  908.        FOyoffset := 17;
  909.        inkwell_width := 64;
  910.        inkwell_height := 20
  911.       END;
  912.  
  913.      2:    
  914.       BEGIN               { high-res }
  915.        xmax := 639;
  916.        ymax := 399;
  917.        menubar := 20;
  918.        bitplanes := 1;
  919.        nextplane := 0;
  920.        aspect := 1;
  921.        rowsize := 80;
  922.        palettesize := 2;
  923.        FOwidth1 := 34;
  924.        FOwidth2 := 68;
  925.        FOxoffset := 8;
  926.        FOyoffset := 32;
  927.        inkwell_width := 128;
  928.        inkwell_height := 40
  929.       END
  930.     END;
  931.     byteplanes := bitplanes * 2
  932.   END;
  933.   
  934.   PROCEDURE Initialize;
  935.    BEGIN
  936.     GetResolution;
  937.     SetVariables;
  938.     GetColors( deskcolors );
  939.     SavePalette;
  940.     ClearPic;
  941.     title := ' MultiPaint ';
  942.     IO_Check( FALSE );
  943.     Attributes
  944.    END;
  945.  
  946.   Pide,title,0,0,0,0 );
  947.      Open_window( window,0,0,0,0 );
  948.      Border_Rect( window,x,y,w,h );
  949.      ClipWindow( x,y,w,h );
  950.      ScrollBars;
  951.      ChangeInfo;
  952.     END
  953.   END;
  954.  
  955. PROCEDURE SketchOff;
  956.  VAR
  957.   current_window : integer;
  958.   dummy : long_integer;
  959.  BEGIN
  960.   Blit_to_Memory;
  961.   IF keystate & alternate = 0 THEN
  962.    SetPalette( Addr_Palette( deskcolors ));
  963.   Close_Window( window );
  964.   Delete_Window( window );
  965.   window := No_Window;
  966.   MouseVector( oldmouse,dummy )
  967.  END;
  968.  
  969. PROCEDURE Perimeter( keystate : integer );
  970.  BEGIN
  971.   IF keystate & control <> 0 THEN
  972.    Paint_OutLine( TRUE )
  973.   ELSE
  974.    Paint_Outline( FALSE )
  975.  END;
  976.  
  977. PROCEDURE DoMagnify( mx,my : integer );
  978.  VAR
  979.   xpix,ypix : integer;
  980.   log : long_integer;
  981.  BEGIN
  982.   xpix := ( mx-gzz_x ) DIV bitsize;
  983.   ypix := ( my-gzz_y ) DIV bitsize;
  984.   IF ( xpix <= bit_w ) AND ( ypix <= bit_h ) THEN
  985.    BEGIN
  986.     Paint_OutLine( TRUE );
  987.     Paint_Style( 1 );
  988.     Line_Style( 1 );
  989.     Line_Width( 1 );
  990.     Hide_Mouse;
  991.     Paint_Rect( gzz_x+( xpix * bitsize ),gzz_y+( ypix * bitsize ),
  992.                 bitsize-1,bitsize-1 );
  993.     Show_Mouse;
  994.     log := Logbase;
  995.     SetScreen( picture,-1,-1 );
  996.     Set_Clip( 0,0,xmax+1,ymax+1 );
  997.     Plot( mag.x_offset+xpix,mag.y_offset+ypix );   
  998.     Set_Clip( gzz_x,gzz_y,gzz_w,gzz_h );
  999.     SetScreen( log,-1,-1 );
  1000.     Attributes
  1001.    END
  1002.  END;
  1003.  
  1004. PROCEDURE DoAirbrush;
  1005.  VAR
  1006.   newx,newy : integer;
  1007.   
  1008.  PROCEDURE FindSpot;
  1009.   BEGIN
  1010.    newx := newx+( SHR( random,5 ) & coverage );
  1011.    Delay( saturation );
  1012.    newy := newy+( SHR( random,5 ) & coverage )
  1013.   END;
  1014.  
  1015.  BEGIN
  1016.   Hide_Mouse;
  1017.   Line_Width( 1 );
  1018.   Paint_Outline( FALSE );
  1019.   IF brushwidth > 1 THEN
  1020.    WHILE ButtonDown( newx,newy ) DO
  1021.     BEGIN
  1022.      FindSpot;
  1023.      Paint_Rect( newx,newy,brushwidth,brusheight )
  1024.     END
  1025.   ELSE 
  1026.    WHILE ButtonDown( newx,newy ) DO
  1027.     BEGIN
  1028.      FindSpot;
  1029.      Plot( newx,newy )
  1030.     END;
  1031.   Attributes;
  1032.   Show_Mouse
  1033.  END;
  1034.  
  1035. PROCEDURE DoLine( keystate,mx,my : integer );
  1036.  VAR
  1037.   newx,newy : integer;
  1038.  
  1039.  PROCEDURE OriginAt( xpos,ypos : integer );
  1040.   BEGIN
  1041.    origx := xpos;
  1042.    origy := ypos
  1043.   END;
  1044.  
  1045.  BEGIN
  1046.   IF keystate & control <> 0 THEN          { establish starting point }
  1047.    BEGIN
  1048.     Set_Mouse( M_Thin_Cross );
  1049.     WHILE Click( leftbutton ) DO  ;
  1050.     OriginAt( int_out[1],int_out[2] );
  1051.     Set_Mouse( M_Arrow )
  1052.    END
  1053.   ELSE
  1054.    BEGIN
  1055.     Hide_Mouse;
  1056.     IF keystate & shiftkeys <> 0 THEN      { Rays }
  1057.      Line( origx,origy,mx,my )
  1058.     ELSE
  1059.      BEGIN                                 { Lines }
  1060.       Draw_Mode( 3 );
  1061.       IF keystate & alternate = 0 THEN     { no Kline }
  1062.        OriginAt( mx,my );
  1063.       WHILE ButtonDown( newx,newy ) DO
  1064.        BEGIN
  1065.         Line( origx,origy,newx,newy );
  1066.         Delay( 25 );
  1067.         Line( origx,origy,newx,newy )
  1068.        END;
  1069.       Draw_Mode( drawmode );
  1070.       Line( origx,origy,newx,newy );
  1071.       OriginAt( newx,newy )
  1072.      END;
  1073.     Show_Mouse
  1074.    END
  1075.  END;
  1076.  
  1077. PROCEDURE DoBox( keystate,mx,my : integer );
  1078.  VAR
  1079.   bwidth,bheight : integer;
  1080.  BEGIN
  1081.   RubberBox( keystate,mx,my,0,0,xmax,ymax,bwidth,bheight );
  1082.   Attributes;
  1083.   IF mode = box THEN
  1084.    BEGIN
  1085.     Perimeter( keystate );
  1086.     IF keystate & alternate <> 0 THEN
  1087.      Paint_Round_Rect( mx,my,bwidth,bheight )
  1088.     ELSE
  1089.      Paint_Rect( mx,my,bwidth,bheight )
  1090.    END
  1091.   ELSE
  1092.    IF keystate & alternate <> 0 THEN
  1093.     Frame_Round_Rect( mx,my,bwidth,bheight )
  1094.    ELSE
  1095.     Frame_Rect( mx,my,bwidth,bheight );
  1096.   Show_Mouse
  1097.  END;
  1098.  
  1099. PROCEDURE DoCircle( keystate,mx,my : integer );
  1100.  VAR
  1101.   xradius,yradius,newx,newy : integer;
  1102.  BEGIN
  1103.   Draw_Mode( 3 );
  1104.   IF mode = disc THEN  Line_Width( 1 );
  1105.   Hide_Mouse;
  1106.   WHILE ButtonDown( newx,newy ) DO
  1107.    BEGIN
  1108.     xradius := ABS( newx-mx );
  1109.     IF keystate & shiftkeys <> 0 THEN
  1110.      yradius := xradius DIV aspect
  1111.     ELSE
  1112.      yradius := ABS( newy-my );
  1113.     Frame_Oval( mx,my,xradius,yradius );
  1114.     Frame_Oval( mx,my,xradius,yradius )
  1115.    END;
  1116.   Attributes;
  1117.   IF mode = disc THEN
  1118.    BEGIN
  1119.     Perimeter( keystate );
  1120.     Paint_Oval( mx,my,xradius,yradius )
  1121.    END
  1122.   ELSE
  1123.    Frame_Oval( mx,my,xradius,yradius );
  1124.   Show_Mouse
  1125.  END;
  1126.  
  1127. PROCEDURE DoDraw( keystate,mx,my : integer );
  1128.  VAR
  1129.   newx,newy : integer;
  1130.   
  1131.  PROCEDURE Point;
  1132.   BEGIN
  1133.    Hide_Mouse;
  1134.    Plot( mx,my );
  1135.    Show_Mouse
  1136.   END;
  1137.  
  1138.  BEGIN
  1139.   Paint_OutLine( TRUE );
  1140.   Line_Style( 1 );
  1141.   Line_Width( 1 );
  1142.   IF brushwidth = 1 THEN
  1143.    CASE keystate & ShiftAlt OF
  1144.     alternate:
  1145.      Point;
  1146.     leftshift,rightshift:
  1147.      BEGIN
  1148.       Point;
  1149.       WHILE Click( leftbutton ) DO  ;
  1150.      END;
  1151.     OTHERWISE:
  1152.      WHILE ButtonDown( newx,newy ) DO
  1153.       BEGIN
  1154.        Hide_Mouse;
  1155.        Line( mx,my,newx,newy );
  1156.        Show_Mouse;
  1157.        mx := newx;
  1158.        my := newy
  1159.       END
  1160.    END
  1161.   ELSE
  1162.    BEGIN
  1163.     Hide_Mouse;
  1164.     Paint_OutLine( FALSE );
  1165.     CASE keystate & ShiftAlt OF
  1166.      alternate:
  1167.       Paint_Rect( mx,my,brushwidth,brusheight );
  1168.      leftshift,rightshift:
  1169.       BEGIN
  1170.        Paint_Rect( mx,my,brushwidth,brusheight );
  1171.        WHILE Click( leftbutton ) DO  ;
  1172.       END;
  1173.      OTHERWISE:
  1174.       WHILE ButtonDown( newx,newy ) DO
  1175.        Paint_Rect( newx,newy,brushwidth,brusheight )
  1176.     END;
  1177.     Show_Mouse
  1178.    END;
  1179.   Attributes
  1180.  END;
  1181.  
  1182. PROCEDURE SetColor( mx : integer );
  1183.  VAR
  1184.   frame_size,inkwell_y : integer;
  1185.  BEGIN
  1186.   Hide_Mouse;
  1187.   Set_Clip( x,y,w,h );
  1188.   frame_size := inkwell_height+2;
  1189.   inkwell_y := y+1;
  1190.   Paint_Style( 1 );
  1191.   Line_Color( 1 );
  1192.   Line_Style( 1 );
  1193.   Line_Width( 1 );
  1194.   Paint_Outline( FALSE );
  1195.   Paint_Color( 0 );
  1196.   Paint_Rect( inkwellspot,y,inkwell_width,frame_size );
  1197.   Paint_Color ( XBIOScolor );
  1198.   IF XBIOScolor = 0 THEN
  1199.    Frame_Rect( inkwellspot,inkwell_y,inkwell_width,inkwell_height )
  1200.   ELSE
  1201.    Paint_Rect( inkwellspot,inkwell_y,inkwell_width,inkwell_height );
  1202.   inkwellcolor := ( mx-x ) DIV inkwell_width;
  1203.   XBIOScolor := XbiosToGem( inkwellcolor );
  1204.   inkwellspot := x+( inkwellcolor*inkwell_width );
  1205.   Frame_Rect( inkwellspot,y,inkwell_width,frame_size );
  1206.   Show_Mouse;
  1207.   Set_Clip( gzz_x,gzz_y,gzz_w,gzz_h );
  1208.   Attributes;
  1209.   IF mode = pal THEN
  1210.    BEGIN
  1211.     ClearWindow;
  1212.     ColorPanel
  1213.    END
  1214.  END;
  1215.  
  1216. PROCEDURE SetPattern( keystate : integer );
  1217.  BEGIN
  1218.   CASE keystate OF
  1219.    control:    paintstyle := 1;            { solid }
  1220.    leftshift,
  1221.    rightshift: paintstyle := 26;           { dither patterns }
  1222.    alternate:  paintstyle := paintstyle-1;
  1223.    OTHERWISE:  paintstyle := paintstyle+1
  1224.   END;
  1225.   IF paintstyle > 37 THEN
  1226.    paintstyle := 0;
  1227.   IF paintstyle < 0  THEN
  1228.    paintstyle := 37;
  1229.   Hide_Mouse;
  1230.   Set_Clip( x,y,w,h );
  1231.   DrawPatternBox;
  1232.   Attributes;
  1233.   Set_Clip( gzz_x,gzz_y,gzz_w,gzz_h );
  1234.   Show_Mouse;
  1235.   Delay( 100 )
  1236.  END;
  1237.  
  1238. PROCEDURE SetRGB( mx,my : integer );
  1239.  VAR
  1240.   i,intensity,gun : integer;
  1241.   
  1242.  PROCEDURE MoveBox( VAR old_intensity : integer; new_intensity : integer );
  1243.   VAR
  1244.    xpos,ypos,size : integer;
  1245.   BEGIN
  1246.    Paint_Color( 0 );
  1247.    Paint_Style( 1 );
  1248.    Hide_Mouse;
  1249.    xpos := gzz_x+rgbsize+1;
  1250.    ypos := gzz_y+(( gun-1 ) * rgbsize )+1;
  1251.    size := rgbsize-2;
  1252.    Paint_Rect( xpos+( old_intensity * rgbsize ),ypos,size,size );
  1253.    Paint_Color( 1 );
  1254.    Paint_Rect( xpos+( new_intensity * rgbsize ),ypos,size,size );
  1255.    Show_Mouse;
  1256.    Delay( 50 );
  1257.    Attributes;
  1258.    old_intensity := new_intensity
  1259.   END;
  1260.   
  1261.  BEGIN
  1262.   intensity := ( mx-gzz_x ) DIV rgbsize;
  1263.   gun := (( my-gzz_y ) DIV rgbsize ) + 1;
  1264.   IF ( gun < 4 ) AND ( intensity < 10 ) THEN 
  1265.    BEGIN
  1266.     CASE intensity OF
  1267.      0:
  1268.       IF RGB[XBIOScolor][gun] > 0 THEN
  1269.        MoveBox( RGB[XBIOScolor][gun],RGB[XBIOScolor][gun]-1 );
  1270.      9:
  1271.       IF RGB[XBIOScolor][gun] < 7 THEN
  1272.        MoveBox( RGB[XBIOScolor][gun],RGB[XBIOScolor][gun]+1 );
  1273.      1,2,3,4,5,6,7,8:
  1274.       MoveBox( RGB[XBIOScolor][gun],intensity-1 )
  1275.     END;
  1276.     dummy := SetGetColor( GemToXbios( XBIOScolor ),
  1277.              ( RGB[XBIOScolor][1]*256 )+( RGB[XBIOScolor][2]*16 )+
  1278.                RGB[XBIOScolor][3] )
  1279.    END
  1280.  END; 
  1281.  
  1282. PROCEDURE DoText( keystate,origx,origy : integer );
  1283.  VAR
  1284.   keystring : Str255;
  1285.   stylemask,len : integer;
  1286.   
  1287.  PROCEDURE DrawText( xpos,ypos : integer );
  1288.   BEGIN
  1289.    Line( xpos-1,ypos,xpos-1,ypos-textsize );
  1290.    Draw_String( xpos,ypos,keystring )
  1291.   END;
  1292.   
  1293.  PROCEDURE Style( keymask,textmask : integer );
  1294.   BEGIN
  1295.    IF keystate & keymask <> 0 THEN
  1296.     stylemask := stylemask | textmask
  1297.   END;
  1298.    
  1299.  BEGIN
  1300.   WHILE Click( leftbutton ) DO  ;
  1301.   Begin_Mouse;
  1302.   Hide_Mouse;
  1303.   Draw_Mode( 3 );
  1304.   Line_Style( 1 );
  1305.   Line_Width( 1 );
  1306.   stylemask := 0;
  1307.   Style( alternate,Thickened );
  1308.   Style( control,Slanted );
  1309.   Style( leftshift,Outlined );
  1310.   Style( rightshift,Underlined );
  1311.   Text_Style( stylemask );
  1312.   keystring := '';
  1313.   DrawText( origx,origy );
  1314.   REPEAT
  1315.    event := EventMulti;
  1316.    IF ( mx <> origx ) OR ( my <> origy ) THEN
  1317.     BEGIN
  1318.      DrawText( origx,origy );
  1319.      DrawText( mx,my );
  1320.      origx := mx;
  1321.      origy := my
  1322.     END
  1323.    ELSE
  1324.     IF event & E_Keyboard <> 0 THEN
  1325.      BEGIN
  1326.       DrawText( origx,origy );
  1327.       len := LENGTH( keystring );
  1328.       IF key = Backspace THEN
  1329.        BEGIN
  1330.         IF len > 0 THEN
  1331.          DELETE( keystring,len,1 )
  1332.        END
  1333.       ELSE
  1334.        IF len < 255 THEN
  1335.         keystring := CONCAT( keystring,CHR( key ));
  1336.       DrawText( mx,my )
  1337.      END
  1338.   UNTIL Click( leftbutton );
  1339.   WHILE Click( leftbutton ) DO  ;
  1340.   DrawText( mx,my );
  1341.   Draw_Mode( drawmode );
  1342.   Draw_String( mx,my,keystring );
  1343.   Show_Mouse;
  1344.   End_Mouse;
  1345.   Attributes
  1346.  END;
  1347.  
  1348. PROCEDURE Sketch( keystate,mx,my : integer );
  1349.  BEGIN
  1350.   CASE mode OF
  1351.    draw:        DoDraw( keystate,mx,my );
  1352.    magnify:     DoMagnify( mx,my );
  1353.    circle,disc: DoCircle( keystate,mx,my );
  1354.    frame,box:   DoBox( keystate,mx,my );
  1355.    airbrush:    DoAirbrush;
  1356.    lines:       DoLine( keystate,mx,my );
  1357.    block:       BlockCopy( keystate,mx,my );
  1358.    fill:        DoPaint( mx,my );  
  1359.    text:        DoText( keystate,mx,my );
  1360.    pal:         SetRGB( mx,my )
  1361.   END
  1362.  END;
  1363.  
  1364.  PROCEDURE Disk( operation : integer );
  1365.   CONST
  1366.    NEO = 2;
  1367.   VAR
  1368.    H,i,header,colors,offset : integer;
  1369.    header_addr,count : long_integer;
  1370.    format : String[60];
  1371.    TM : char;
  1372.   BEGIN
  1373.    header := 34;
  1374.    colors := 34;
  1375.    offset := 2;
  1376.    TM := CHR( $BF );
  1377.    format := CONCAT('[2][ | |     Which Format?     | ][ DEGAS',TM,
  1378.                     ' | NEOchrome',TM,' ]' );
  1379.    IF rez = 0 THEN
  1380.     IF Do_Alert( format,0 ) = NEO THEN
  1381.      BEGIN
  1382.       header := 128;
  1383.       colors := 36;
  1384.       offset := 4
  1385.      END;
  1386.    IF Get_In_File( path,p_name ) THEN
  1387.     BEGIN
  1388.      Set_Mouse( M_Bee );
  1389.      CASE operation OF
  1390.       LoadPic:
  1391.        BEGIN
  1392.         Reset( Input,p_name );
  1393.         IF EOF( Input ) THEN
  1394.          LoadError
  1395.         ELSE
  1396.          BEGIN
  1397.           H := Handle( Input );
  1398.           count := F_Seek( 0,H,0 ); 
  1399.           count := F_Read( H,colors,pic_start );
  1400.           SetPalette( pic_start+offset );
  1401.           Delay( 60 );
  1402.           SavePalette;
  1403.           count := F_Seek( header,H,0 );
  1404.           count := F_Read( H,32000,picture );
  1405.           Close( Input );
  1406.           IF count <> 32000 THEN
  1407.            LoadError
  1408.          END
  1409.        END;
  1410.       SavePic:  
  1411.        BEGIN
  1412.         P_TO_CSTR( p_name,c_name );
  1413.         H := F_Create( c_name,0 );
  1414.         IF  H >= 0  THEN                 { Error? }
  1415.          BEGIN
  1416.           IF picture-pic_start >= header THEN
  1417.            header_addr := pic_start
  1418.           ELSE
  1419.            header_addr := picture+32000;
  1420.           FOR i := 0 TO header-1 DO
  1421.            POKE( header_addr+i,0 );
  1422.           WPOKE( header_addr,rez );
  1423.           MOVE_WORD( Addr_Palette( sketchcolors ),header_addr+offset,16 );
  1424.           count := F_Seek( 0,H,2 ); 
  1425.           count := F_Write( H,header,header_addr );
  1426.           count := F_Seek( 0,H,2 );
  1427.           count := F_Write( H,32000,picture );
  1428.           dummy := F_Close( H );
  1429.           IF count <> 32000 THEN
  1430.            SaveError
  1431.          END
  1432.         ELSE
  1433.          SaveError
  1434.        END
  1435.      END;
  1436.      Set_Mouse( M_Arrow )
  1437.     END
  1438.   END;
  1439.  
  1440.  FUNCTION Chosen( dialogptr : Dialog_Ptr; index : integer ) : boolean;
  1441.   BEGIN
  1442.    Chosen := Obj_State( dialogptr,index ) & 1 <> 0
  1443.   END;
  1444.    
  1445. PROCEDURE SetOptions;
  1446.  VAR
  1447.   i : integer;
  1448.  BEGIN
  1449.   FOR i := narrow TO wide DO
  1450.    IF Chosen( dialog2_ptr,i ) THEN
  1451.     coverage := i;
  1452.    CASE coverage OF
  1453.     narrow: coverage := 7;
  1454.     medium: coverage := 31;
  1455.     wide:   coverage := 63
  1456.    END;
  1457.     
  1458.   FOR i := heavy TO light DO
  1459.    IF Chosen( dialog2_ptr,i ) THEN
  1460.     saturation := i;
  1461.   CASE saturation OF
  1462.    heavy:    saturation := 0;
  1463.    moderate: saturation := 35;
  1464.    light:    saturation := 70
  1465.   END;
  1466.  
  1467.   FOR i := line1 TO line6 DO
  1468.    IF Chosen( dialog2_ptr,i ) THEN
  1469.     linestyle := i-( line1-1 );
  1470.   Line_Style( linestyle );
  1471.   
  1472.   FOR i := brush1 TO brush6 DO
  1473.    IF Chosen( dialog2_ptr,i ) THEN
  1474.     BEGIN
  1475.      brushwidth := (( i-brush1 )*4 )+1;
  1476.      CASE i OF
  1477.       brush1: textsize := 3;
  1478.       brush2: textsize := 4;
  1479.       brush3: textsize := 6;
  1480.       brush4: textsize := 12;
  1481.       brush5: textsize := 13;
  1482.       brush6: textsize := 26
  1483.      END 
  1484.     END;
  1485.   brusheight := brushwidth DIV aspect;
  1486.   Line_Width( brushwidth );
  1487.   bitsize := brushwidth+1;
  1488.   Limit( bitsize,6,22 )
  1489.  END;
  1490.  
  1491. PROCEDURE OptionDialog;
  1492.  VAR
  1493.   option_button : Tree_Index;
  1494.  BEGIN
  1495.   Center_Dialog( dialog2_ptr );
  1496.   option_button := Do_Dialog( dialog2_ptr,0 );
  1497.   Obj_Setstate( dialog2_ptr,ok2,Normal,TRUE );
  1498.   End_Dialog( dialog2_ptr );
  1499.   SetOptions
  1500.  END;
  1501.  
  1502. PROCEDURE SketchDialog;
  1503.  VAR
  1504.   i,clear_picture : integer;
  1505.   sketch_button  : Tree_Index;
  1506.   
  1507.  BEGIN
  1508.   Begin_Mouse;
  1509.   Blit_to_Memory;
  1510.   Center_Dialog( dialog1_ptr );
  1511.   sketch_button := Do_Dialog( dialog1_ptr,0 );
  1512.   LOOP
  1513.    clear_picture := 0;
  1514.    IF Chosen( dialog1_ptr,load ) THEN
  1515.     BEGIN
  1516.      Obj_Setstate( dialog1_ptr,load,Normal,TRUE );
  1517.      Disk( LoadPic );
  1518.      Show_Dialog( dialog1_ptr,0 )
  1519.     END
  1520.    ELSE 
  1521.     IF Chosen( dialog1_ptr,save ) THEN
  1522.      BEGIN
  1523.       Obj_Setstate( dialog1_ptr,save,Normal,TRUE );
  1524.       Disk( SavePic );
  1525.       Show_Dialog( dialog1_ptr,0 )
  1526.      END;
  1527.  
  1528.    IF Chosen( dialog1_ptr,wipe ) THEN
  1529.     BEGIN
  1530.      Obj_Setstate( dialog1_ptr,wipe,Normal,TRUE );
  1531.      clear_picture := Do_Alert
  1532.      ('[3][ |  Wipe Picture?   |  Are You Sure?  | ][ Yes | No ]',1 );
  1533.      IF clear_picture = 1 THEN
  1534.       BEGIN
  1535.        ClearWindow;
  1536.        ClearPic
  1537.       END
  1538.     END;
  1539.  
  1540.    IF Chosen( dialog1_ptr,option ) THEN
  1541.     BEGIN
  1542.      Obj_Setstate( dialog1_ptr,option,Normal,TRUE );
  1543.      OptionDialog;
  1544.      Show_Dialog( dialog1_ptr,0 );
  1545.      sketch_button := 0
  1546.     END;
  1547.   
  1548.    EXIT IF ( clear_picture = 1 ) OR ( sketch_button = OK1 );
  1549.    sketch_button := Redo_Dialog( dialog1_ptr,0 )
  1550.   END;
  1551.   Obj_Setstate( dialog1_ptr,wipe,Normal,TRUE );
  1552.   Obj_Setstate( dialog1_ptr,ok1,Normal,TRUE );
  1553.   End_Dialog( dialog1_ptr );
  1554.  
  1555.   IF Chosen( dialog1_ptr,clear ) THEN
  1556.    drawmode := transparent_mode
  1557.   ELSE
  1558.    drawmode := opaque_mode;
  1559.   Draw_Mode( drawmode );
  1560.   blitmode := SHORT_TRUNC( 3.5 * drawmode );
  1561.     
  1562.   FOR i := draw TO text DO
  1563.    IF Chosen( dialog1_ptr,i ) THEN
  1564.     mode := i;
  1565.   
  1566.   ScrollBars;
  1567.   ChangeInfo;
  1568.   End_Mouse
  1569.  END;
  1570.  
  1571. PROCEDURE Options;
  1572.  BEGIN
  1573.   Begin_Mouse;
  1574.   Blit_to_Memory;
  1575.   OptionDialog;
  1576.   ScrollBars;
  1577.   End_Mouse
  1578.  END;
  1579.  
  1580. PROCEDURE GetEvent;
  1581.  VAR
  1582.   handle,xpos,ypos,width,height : integer;
  1583.   log,dummy : long_integer;
  1584.   
  1585.  PROCEDURE Arrow( VAR xpos,ypos,v_slide,h_slide : integer; 
  1586.                   x_limit,y_limit,x_slide,y_slide,x_inc,y_inc : integer );
  1587.   BEGIN
  1588.    CASE msg[4] OF
  1589.     0: BEGIN  ypos := 0;          v_slide := 1                END;
  1590.     1: BEGIN  ypos := y_limit;    v_slide := 1000             END;
  1591.     2: BEGIN  ypos := ypos-y_inc; v_slide := v_slide-y_slide  END;
  1592.     3: BEGIN  ypos := ypos+y_inc; v_slide := v_slide+y_slide  END;
  1593.     4: BEGIN  xpos := 0;          h_slide := 1                END;
  1594.     5: BEGIN  xpos := x_limit;    h_slide := 1000             END;
  1595.     6: BEGIN  xpos := xpos-x_inc; h_slide := h_slide-x_slide  END;
  1596.     7: BEGIN  xpos := xpos+x_inc; h_slide := h_slide+x_slide  END
  1597.    END;       
  1598.    Limit( ypos,0,y_limit );
  1599.    Limit( xpos,0,x_limit );
  1600.    Limit( v_slide,1,1000 );
  1601.    Limit( h_slide,1,1000 );
  1602.    Wind_Set( window,WF_HSlide,h_slide,0,0,0 );
  1603.    Wind_Set( window,WF_VSlide,v_slide,0,0,0 )
  1604.   END;
  1605.  
  1606.  
  1607.  BEGIN
  1608.   event  := EventMulti;
  1609.   handle := Front_Window;
  1610.   
  1611.   IF handle = window THEN
  1612.    BEGIN
  1613.     IF Click( rightbutton ) THEN
  1614.      BEGIN
  1615.       Begin_Mouse;
  1616.       Blit_to_Memory;
  1617.       screen := Physbase;
  1618.       log := Logbase;
  1619.       SetScreen( picture,picture,-1 );
  1620.       MouseVector( oldmouse,dummy );
  1621.       Set_Clip( 0,0,xmax+1,ymax+1 );
  1622.       WHILE Click( rightbutton ) DO  ;
  1623.       WHILE NOT Click( rightbutton ) DO
  1624.        IF int_out[3] & leftbutton <> 0 THEN
  1625.         CASE mode OF
  1626.          magnify,pal,block:  ;
  1627.          OTHERWISE:  Sketch( int_out[4],int_out[1],int_out[2] )
  1628.         END;
  1629.       WHILE Click( rightbutton ) DO  ;
  1630.       TrapMouse;
  1631.       SetScreen( log,screen,-1 );
  1632.       Set_Clip( gzz_x,gzz_y,gzz_w,gzz_h );
  1633.       Blit_to_Screen;
  1634.       End_Mouse
  1635.      END
  1636.     END
  1637.    ELSE
  1638.     IF keystate & ShiftAltCntrl = ShiftAltCntrl THEN
  1639.      BEGIN
  1640.       Hide_Mouse;
  1641.       screen := Physbase;
  1642.       SetScreen( -1,picture,-1 );
  1643.       Delay( 500 );
  1644.       Work_Rect( handle,xpos,ypos,width,height );
  1645.       CopyRaster( screen,picture,xpos,ypos,xpos,ypos,xpos,ypos,
  1646.                   width,height,blitmode );
  1647.       IF keystate & rightshift <> 0 THEN
  1648.        SavePalette;
  1649.       WHILE keystate & ShiftAltCntrl <> 0 DO
  1650.        event := EventMulti;
  1651.       SetScreen( -1,screen,-1 );
  1652.       Show_Mouse
  1653.      END;
  1654.       
  1655.  
  1656.   IF event & E_Message <> 0 THEN
  1657.    CASE msg[0] OF
  1658.  
  1659.     AC_Open:
  1660.      IF window = No_Window THEN
  1661.       SketchOn;
  1662.       
  1663.     AC_Close:
  1664.      IF window <> No_Window THEN
  1665.       window := No_Window;
  1666.       
  1667.     WM_Closed:      
  1668.      SketchOff;
  1669.  
  1670.     WM_Redraw:
  1671.      Redraw;
  1672.  
  1673.     WM_Arrowed:
  1674.      BEGIN
  1675.       Blit_to_Memory;
  1676.       CASE mode OF
  1677.        magnify:
  1678.         WITH mag DO 
  1679.          Arrow( x_offset,y_offset,v_slide,h_slide,x_limit,y_limit,
  1680.                 x_slide,y_slide,x_inc,y_inc );
  1681.        pal:  ;
  1682.        OTHERWISE:
  1683.         WITH wind DO
  1684.          Arrow( x_offset,y_offset,v_slide,h_slide,x_limit,y_limit,
  1685.                 x_slide,y_slide,x_inc,y_inc )
  1686.       END;
  1687.       Redraw
  1688.      END;
  1689.     
  1690.     WM_HSlid:
  1691.      BEGIN
  1692.       Blit_to_Memory;
  1693.       CASE mode OF
  1694.        magnify:
  1695.         WITH mag DO
  1696.          BEGIN
  1697.           h_slide := msg[4]+1;
  1698.           x_offset := Slider( h_slide,x_limit,WF_HSlide )
  1699.          END;
  1700.        pal: ;
  1701.        OTHERWISE:
  1702.         WITH wind DO
  1703.          BEGIN
  1704.           h_slide := msg[4]+1;
  1705.           x_offset := Slider( h_slide,x_limit,WF_HSlide )
  1706.          END     
  1707.       END;
  1708.       Redraw
  1709.      END; 
  1710.      
  1711.     WM_VSlid:
  1712.      BEGIN
  1713.       Blit_to_Memory;
  1714.       CASE mode OF
  1715.        magnify:
  1716.         WITH mag DO
  1717.          BEGIN
  1718.           v_slide := msg[4]+1;
  1719.           y_offset := Slider( v_slide,y_limit,WF_VSlide )
  1720.          END;
  1721.        pal: ;
  1722.        OTHERWISE:
  1723.         WITH wind DO
  1724.          BEGIN
  1725.           v_slide := msg[4]+1;
  1726.           y_offset := Slider( v_slide,y_limit,WF_VSlide )
  1727.          END
  1728.       END;
  1729.       Redraw
  1730.      END
  1731.    END;     
  1732.  
  1733.    IF event & E_Keyboard <> 0 THEN
  1734.     CASE key OF
  1735.      F1,Help:
  1736.       SketchDialog;
  1737.      F2:
  1738.       Options;
  1739.      Escape:
  1740.       SketchOff;
  1741.      Undo: 
  1742.       IF mode = pal THEN
  1743.        BEGIN
  1744.         SetPalette( Addr_Palette( sketchcolors ));
  1745.         Delay( 60 );
  1746.         StoreColors;
  1747.         ClearWindow;
  1748.         ColorPanel
  1749.        END
  1750.       ELSE
  1751.        Blit_to_Screen;
  1752.      Tab:
  1753.       IF rez = 2 THEN
  1754.        BEGIN
  1755.         dummy := SetGetColor( 0,( ~SetGetColor( 0,-1 ) & $777 ));
  1756.         GetColors( sketchcolors )
  1757.        END
  1758.     END;
  1759.     
  1760.    IF event & E_MRect_1 <> 0 THEN      
  1761.     IF event & E_Button <> 0 THEN
  1762.      BEGIN
  1763.       IF my < ( y+inkwell_height+2 ) THEN
  1764.        BEGIN
  1765.         IF mx < ( x+patternspot-1 ) THEN
  1766.          SetColor( mx )
  1767.         ELSE
  1768.          BEGIN
  1769.           IF mx < Fx THEN
  1770.            SetPattern( keystate )
  1771.           ELSE
  1772.            BEGIN
  1773.             IF mx < Ox THEN
  1774.              SketchDialog
  1775.             ELSE
  1776.              Options
  1777.            END
  1778.          END
  1779.        END
  1780.       ELSE
  1781.        Sketch( keystate,mx,my )
  1782.      END
  1783.   END;
  1784.  
  1785.  
  1786.   BEGIN
  1787.    ap_id := Init_Gem;
  1788.     IF ap_id >= 0 THEN
  1789.      BEGIN
  1790.       desk_name := '  MultiPaint ';
  1791.       menu_id := Menu_Register( ap_id,desk_name );
  1792.       IF getrez < 2 THEN
  1793.        resource := 'color.rsc'
  1794.       ELSE
  1795.        resource := 'mono.rsc';
  1796.       IF Load_Resource( resource ) THEN
  1797.        BEGIN
  1798.         Find_Dialog( dialog1,dialog1_ptr );
  1799.         Find_Dialog( dialog2,dialog2_ptr )
  1800.        END
  1801.       ELSE
  1802.        WHILE TRUE DO
  1803.         IF EventMulti & E_Message <> 0 THEN
  1804.          dummy := Do_Alert( '[1][ | | No Resource File! | ][ Cancel ]',1 );
  1805.       window := No_Window;
  1806.       Initialize;
  1807.       WHILE TRUE DO
  1808.        GetEvent
  1809.      END
  1810.   END.
  1811.