-
Notifications
You must be signed in to change notification settings - Fork 1
/
agarcob.cbl
2326 lines (2263 loc) · 78.4 KB
/
agarcob.cbl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
000010 identification division.
000020 program-id. agarcob is recursive.
000030
000040*
000050* agar connector for GNUCOBOL
000060*
000070* FIRST 1th AUGUST 0.1.0 LAST 26.09.2021
000080*
000090* Copyright (C) 2012-2021 Federico Priolo TP ONE SRL
000100*
000110* This program is free software; you can redistribute it and/or modify
000120* it under the terms of the GNU General Public License as published by
000130* the Free Software Foundation; either version 2, or (at your option)
000140* any later version.
000150*
000160* This program is distributed in the hope that it will be useful,
000170* but WITHOUT ANY WARRANTY; without even the implied warranty of
000180* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
000190* GNU General Public License for more details.
000200*
000210* You should have received a copy of the GNU General Public License
000220* along with this software; see the file COPYING. If not, write to
000230* the Free Software Foundation, 51 Franklin Street, Fifth Floor
000240* Boston, MA 02110-1301 USA
000250*
000260*
000270*---------------------------------------------------------------------
000280 data division.
000290
000300 working-storage section.
000310 01 ind usage binary-long unsigned.
000320 01 ind2 usage binary-long unsigned.
000330
000340 01 pane-instance based.
000350 05 filler pic x(712).
000350* 05 filler pic x(724). linux
000350* 05 filler pic x(720). debug windows
000360
000370 05 pane-type usage binary-long sync.
000380 05 pane-flags usage binary-long unsigned.
000390
000400 05 pane-divs occurs 2 times usage pointer sync.
01 menu-instance based.
05 filler pic x(712).
05 menu-flags usage binary-long sync.
05 menu-style usage binary-long sync.
05 menu-root usage pointer sync.
000410
000420
000430 01 combo-instance based.
000440 04 filler pic x(712).
000450
000460 04 resto-combo.
000470 05 combo-flags usage binary-long sync.
000480 05 combo-tbox usage pointer sync.
000490 05 combo-button usage pointer.
000500 05 combo-tlist usage pointer.
000510 05 combo-panel usage pointer.
000520 05 combo-wsaved usage binary-long sync.
000530 05 combo-hsaved usage binary-long.
000540 05 combo-wprelist usage binary-long.
000550 05 combo-hprelist usage binary-long.
000560
000570
000580
000590 01 window-instance based.
000600 04 filler pic x(640).
000610 04 resto-win.
000620 05 win-flags usage binary-long sync.
000630
000640
000650 01 object-flags.
000660 05 AG-OBJECT-FLOATING-VARS usage binary-long value h'00001'.
000670 05 AG-OBJECT-NON-PERSISTENT usage binary-long value h'00002'.
000680 05 AG-OBJECT-INDESTRUCTIBLE usage binary-long value h'00004'.
000690 05 AG-OBJECT-RESIDENT usage binary-long value h'00008'.
000700 05 AG-OBJECT-PRESERVE-DEPS usage binary-long value h'00010'.
000710 05 AG-OBJECT-STATIC usage binary-long value h'00020'.
000720 05 AG-OBJECT-READONLY usage binary-long value h'00040'.
000730 05 AG-OBJECT-WAS-RESIDENT usage binary-long value h'00080'.
000740 05 AG-OBJECT-REOPEN-ONLOAD usage binary-long value h'00200'.
000750 05 AG-OBJECT-REMAIN-DATA usage binary-long value h'00400'.
000760 05 AG-OBJECT-DEBUG usage binary-long value h'00800'.
000770 05 AG-OBJECT-NAME-ONATTACH usage binary-long value h'01000'.
000780 05 AG-OBJECT-CHLD-AUTOSAVE usage binary-long value h'02000'.
000790 05 AG-OBJECT-DEBUG-DATA usage binary-long value h'04000'.
000800 05 AG-OBJECT-INATTACH usage binary-long value h'08000'.
000810 05 AG-OBJECT-INDETACH usage binary-long value h'10000'.
000820*> 05 AG-OBJECT-SAVED-FLAGS usage binary-long value h'G_OBJ'.
000830*> 05 AG-OBJECT-DUPED-FLAGS usage binary-long value h'G_OBJ'.
000840
000850 01 window-positions.
000860 05 AG-WINDOW-NONE usage binary-long value 0.
000870 05 AG-WINDOW-UPPER-LEFT usage binary-long value 1.
000880 05 AG-WINDOW-UPPER-CENTER usage binary-long value 2.
000890 05 AG-WINDOW-UPPER-RIGHT usage binary-long value 3.
000900 05 AG-WINDOW-MIDDLE-LEFT usage binary-long value 4.
000910 05 AG-WINDOW-CENTER usage binary-long value 5.
000920 05 AG-WINDOW-MIDDLE-RIGHT usage binary-long value 6.
000930 05 AG-WINDOW-LOWER-LEFT usage binary-long value 7.
000940 05 AG-WINDOW-LOWER-CENTER usage binary-long value 8.
000950 05 AG-WINDOW-LOWER-RIGHT usage binary-long value 9.
000960 05 AG-WINDOW-LAST usage binary-long value 10.
000970
000980 01 progress-flags.
000990 05 AG-PROGRESS-BAR-HFILL USAGE binary-long value "01".
001000 05 AG-PROGRESS-BAR-VFILL USAGE binary-long value "02".
001010 05 AG-PROGRESS-BAR-SHOW-PCT USAGE binary-long value "04".
001020 05 AG-PROGRESS-BAR-EXCL USAGE binary-long value "08".
001030 05 AG-PROGRESS-EXPAND USAGE binary-long value "03".
001040
001050 01 box-types.
001060 05 AG-BOX-HORIZ usage binary-long value 0.
001070 05 AG-BOX-VERT usage binary-long value 1.
001080
001090 01 box-flags.
001100 05 AG-BOX-HOMOGENOUS usage binary-long value h'01'.
001110 05 AG-BOX-HFILL usage binary-long value h'02'.
001120 05 AG-BOX-VFILL usage binary-long value h'04'.
001130 05 AG-BOX-FRAME usage binary-long value h'08'.
001140 05 AG-BOX-EXPAND usage binary-long value h'06'.
001150 05 AG-BOX-DEFAULT usage binary-long value h'06'.
001160
001170 01 label-flags.
001180 05 AG-LABEL-HFILL usage binary-long value h'01'.
001190 05 AG-LABEL-VFILL usage binary-long value h'02'.
001200 05 AG-LABEL-NOMINSIZE usage binary-long value h'04'.
001210 05 AG-LABEL-PARTIAL usage binary-long value h'10'.
001220 05 AG-LABEL-REGEN usage binary-long value h'20'.
001230 05 AG-LABEL-FRAME usage binary-long value h'80'.
001240 05 AG-LABEL-EXPAND usage binary-long value h'03'.
001250 01 button-flags.
001260 05 AG-BUTTON-STICKY usage binary-long value h'0002'.
001270 05 AG-BUTTON-REPEAT usage binary-long value h'0008'.
001280 05 AG-BUTTON-HFILL usage binary-long value h'0010'.
001290 05 AG-BUTTON-VFILL usage binary-long value h'0020'.
001300 05 AG-BUTTON-INVSTATE usage binary-long value h'0400'.
001310 05 AG-BUTTON-KEYDOWN usage binary-long value h'0800'.
001320 05 AG-BUTTON-EXCL usage binary-long value h'1000'.
001330 05 AG-BUTTON-NOEXCL usage binary-long value h'2000'.
001340 05 AG-BUTTON-EXPAND usage binary-long value h'0030'.
001350 05 AG-BUTTON-DEFAULT usage binary-long value h'2000'.
001360 01 wcombo-flags.
001370 05 AG-COMBO-POLL usage binary-long value h'01'.
001380 05 AG-COMBO-TREE usage binary-long value h'02'.
001390 05 AG-COMBO-ANY-TEXT usage binary-long value h'04'.
001400 05 AG-COMBO-HFILL usage binary-long value h'08'.
001410 05 AG-COMBO-VFILL usage binary-long value h'10'.
001420 05 AG-COMBO-SCROLLTOSEL usage binary-long value h'40'.
001430 05 AG-COMBO-EXPAND usage binary-long value h'18'.
001440
001450
001460
001470
001480 01 console-flags.
001490 05 AG-CONSOLE-HFILL usage binary-long value h'01'.
001500 05 AG-CONSOLE-VFILL usage binary-long value h'02'.
001510 05 AG-CONSOLE-NOAUTOSCROLL usage binary-long value h'04'.
001520 05 AG-CONSOLE-NOPOPUP usage binary-long value h'08'.
001530 05 AG-CONSOLE-EXPAND usage binary-long value h'03'.
001540 05 AG-CONSOLE-SELECTING usage binary-long value h'10'.
001550
001560 01 cpu-ext-bits.
001570 05 AG-EXT-CPUID usage binary-long value 1.
001580 05 AG-EXT-MMX usage binary-long value 2.
001590 05 AG-EXT-MMX-EXT usage binary-long value 4.
001600 05 AG-EXT-3DNOW usage binary-long value 8.
001610 05 AG-EXT-3DNOW-EXT usage binary-long value 16.
001620 05 AG-EXT-ALTIVEC usage binary-long value 32.
001630 05 AG-EXT-SSE usage binary-long value 64.
001640 05 AG-EXT-SSE2 usage binary-long value 128.
001650 05 AG-EXT-SSE3 usage binary-long value 256.
001660 05 AG-EXT-LONG-MODE usage binary-long value 512.
001670 05 AG-EXT-RDTSCP usage binary-long value 1024.
001680 05 AG-EXT-FXSR usage binary-long value 2048.
001690 05 AG-EXT-PAGE-NX usage binary-long value 4096.
001700 05 AG-EXT-SSE5A usage binary-long value 8192.
001710 05 AG-EXT-3DNOW-PREFETCH usage binary-long value 16384.
001720 05 AG-EXT-SSE-MISALIGNED usage binary-long value 32768.
001730 05 AG-EXT-SSE4A usage binary-long value 65536.
001740 05 AG-EXT-ONCHIP-FPU usage binary-long value 131072.
001750 05 AG-EXT-TSC usage binary-long value 262144.
001760 05 AG-EXT-CMOV usage binary-long value 524288.
001770 05 AG-EXT-CLFLUSH usage binary-long value 1048576.
001780 05 AG-EXT-HTT usage binary-long value 2097152.
001790 05 AG-EXT-MON usage binary-long value 4194304.
001800 05 AG-EXT-VMX usage binary-long value 8388608.
001810 05 AG-EXT-SSSE3 usage binary-long value 16777216.
001820 05 AG-EXT-SSE41 usage binary-long value 33554432.
001830 05 AG-EXT-SSE42 usage binary-long value 67108864.
001840
001850 01 dirdlg-flags.
001860 05 AG-DIRDLG-MULTI usage binary-long value h'001'.
001870 05 AG-DIRDLG-CLOSEWIN usage binary-long value h'002'.
001880 05 AG-DIRDLG-LOAD usage binary-long value h'004'.
001890 05 AG-DIRDLG-SAVE usage binary-long value h'008'.
001900 05 AG-DIRDLG-ASYNC usage binary-long value h'010'.
001910 05 AG-DIRDLG-RESET-ONSHOW usage binary-long value h'020'.
001920 05 AG-DIRDLG-HFILL usage binary-long value h'100'.
001930 05 AG-DIRDLG-VFILL usage binary-long value h'200'.
001940 05 AG-DIRDLG-EXPAND usage binary-long value h'300'.
001950 05 AG-DIRDLG-NOBUTTONS usage binary-long value h'400'.
001960
001970 01 editable-flags.
001980 05 AG-EDITABLE-HFILL usage binary-long value h'00001'.
001990 05 AG-EDITABLE-VFILL usage binary-long value h'00002'.
002000 05 AG-EDITABLE-EXPAND usage binary-long value h'00003'.
002010 05 AG-EDITABLE-MULTILINE usage binary-long value h'00004'.
002020 05 AG-EDITABLE-BLINK-ON usage binary-long value h'00008'.
002030 05 AG-EDITABLE-PASSWORD usage binary-long value h'00010'.
002040 05 AG-EDITABLE-ABANDON-FOCUS usage binary-long value h'00020'.
002050 05 AG-EDITABLE-INT-ONLY usage binary-long value h'00040'.
002060 05 AG-EDITABLE-FLT-ONLY usage binary-long value h'00080'.
002070 05 AG-EDITABLE-CATCH-TAB usage binary-long value h'00100'.
002080 05 AG-EDITABLE-CURSOR-MOVING usage binary-long value h'00200'.
002090 05 AG-EDITABLE-KEEPVISCURSOR usage binary-long value h'00800'.
002100 05 AG-EDITABLE-MARKPREF usage binary-long value h'02000'.
002110 05 AG-EDITABLE-EXCL usage binary-long value h'04000'.
002120 05 AG-EDITABLE-NOEMACS usage binary-long value h'08000'.
002130 05 AG-EDITABLE-NOLATIN1 usage binary-long value h'20000'.
002140 05 AG-EDITABLE-WORDWRAP usage binary-long value h'40000'.
002150 05 AG-EDITABLE-NOPOPUP usage binary-long value h'80000'.
002160 05 AG-EDITABLE-WORDSELECT usage binary-long value h'100000'.
002170 05 AG-EDITABLE-READONLY usage binary-long value h'200000'.
002180 05 AG-EDITABLE-MULTILINGUAL usage binary-long value h'400000'.
002190
002200 01 exec-wait-types.
002210 05 AG-EXEC-WAIT-IMMEDIATE usage binary-long value 0.
002220 05 AG-EXEC-WAIT-INFINITE usage binary-long value 1.
002230
002240 01 filedlg-flags.
002250 05 AG-FILEDLG-MULTI usage binary-long value h'0001'.
002260 05 AG-FILEDLG-CLOSEWIN usage binary-long value h'0002'.
002270 05 AG-FILEDLG-LOAD usage binary-long value h'0004'.
002280 05 AG-FILEDLG-SAVE usage binary-long value h'0008'.
002290 05 AG-FILEDLG-ASYNC usage binary-long value h'0010'.
002300 05 AG-FILEDLG-RESET-ONSHOW usage binary-long value h'0020'.
002310 05 AG-FILEDLG-HFILL usage binary-long value h'0100'.
002320 05 AG-FILEDLG-VFILL usage binary-long value h'0200'.
002330 05 AG-FILEDLG-EXPAND usage binary-long value h'0300'.
002340 05 AG-FILEDLG-NOBUTTONS usage binary-long value h'0400'.
002350 05 AG-FILEDLG-MASK-EXT usage binary-long value h'0800'.
002360 05 AG-FILEDLG-MASK-HIDDEN usage binary-long value h'1000'.
002370 05 AG-FILEDLG-NOMASKOPTS usage binary-long value h'2000'.
002380 05 AG-FILEDLG-NOTYPESELECT usage binary-long value h'4000'.
002390
002400 01 fixed-flags.
002410 05 AG-FIXED-HFILL usage binary-long value h'01'.
002420 05 AG-FIXED-VFILL usage binary-long value h'02'.
002430 05 AG-FIXED-NO-UPDATE usage binary-long value h'04'.
002440 05 AG-FIXED-FILLBG usage binary-long value h'08'.
002450 05 AG-FIXED-BOX usage binary-long value h'10'.
002460 05 AG-FIXED-INVBOX usage binary-long value h'20'.
002470 05 AG-FIXED-FRAME usage binary-long value h'40'.
002480 05 AG-FIXED-EXPAND usage binary-long value h'03'.
002490 05 AG-FIXED-DEFAULT usage binary-long value h'43'.
002500
002510 01 graph-flags.
002520 05 AG-GRAPH-HFILL usage binary-long value h'01'.
002530 05 AG-GRAPH-VFILL usage binary-long value h'02'.
002540 05 AG-GRAPH-EXPAND usage binary-long value h'03'.
002550 05 AG-GRAPH-SCROLL usage binary-long value h'04'.
002560 05 AG-GRAPH-DRAGGING usage binary-long value h'08'.
002570 05 AG-GRAPH-PANNING usage binary-long value h'10'.
002580 05 AG-GRAPH-NO-MOVE usage binary-long value h'20'.
002590 05 AG-GRAPH-NO-SELECT usage binary-long value h'40'.
002600 05 AG-GRAPH-NO-MENUS usage binary-long value h'80'.
002610 05 AG-GRAPH-READONLY usage binary-long value h'E0'.
002620
002630 01 graph-vertex-flags.
002640 05 AG-GRAPH-VERTEX-RECTANGLE usage binary-long value 0.
002650 05 AG-GRAPH-VERTEX-CIRCLE usage binary-long value 1.
002660
002670
002680 01 plotter-types.
002690 05 AG-PLOTTER-POINTS usage binary-long value 0.
002700 05 AG-PLOTTER-LINES usage binary-long value 1.
002710
002720 01 plotter-flags.
002730 05 AG-FIXED-PLOTTER-SCROLL usage binary-long value 1.
002740 05 AG-FIXED-PLOTTER-XAXIS usage binary-long value 2.
002750 05 AG-FIXED-PLOTTER-HFILL usage binary-long value 4.
002760 05 AG-FIXED-PLOTTER-VFILL usage binary-long value 8.
002770 05 AG-FIXED-PLOTTER-EXPAND usage binary-long value 12.
002780
002790 01 fontselector-flags.
002800 05 AG-FONTSELECTOR-UPDATE usage binary-long value h'001'.
002810 05 AG-FONTSELECTOR-HFILL usage binary-long value h'100'.
002820 05 AG-FONTSELECTOR-VFILL usage binary-long value h'200'.
002830 05 AG-FONTSELECTOR-EXPAND usage binary-long value h'300'.
002840
002850 01 hsvpal-flags.
002860 05 AG-HSVPAL-PIXEL usage binary-long value h'01'.
002870 05 AG-HSVPAL-DIRTY usage binary-long value h'02'.
002880 05 AG-HSVPAL-HFILL usage binary-long value h'04'.
002890 05 AG-HSVPAL-VFILL usage binary-long value h'08'.
002900 05 AG-HSVPAL-NOALPHA usage binary-long value h'10'.
002910 05 AG-HSVPAL-FORCE-NOALPHA usage binary-long value h'10'.
002920 05 AG-HSVPAL-NOPREVIEW usage binary-long value h'20'.
002930 05 AG-HSVPAL-SHOW-RGB usage binary-long value h'40'.
002940 05 AG-HSVPAL-SHOW-HSV usage binary-long value h'80'.
002950 05 AG-HSVPAL-EXPAND usage binary-long value h'0C'.
002960
002970
002980 01 mpane-flags.
002990 05 AG-MPANE-HFILL usage binary-long value h'01'.
003000 05 AG-MPANE-VFILL usage binary-long value h'02'.
003010 05 AG-MPANE-FRAMES usage binary-long value h'04'.
003020 05 AG-MPANE-FORCE-DIV usage binary-long value h'08'.
003030 05 AG-MPANE-EXPAND usage binary-long value h'03'.
003040 05 AG-MPANE-DEFAULT usage binary-long value h'09'.
003050
003060
003070 01 mpane-layouts.
003080 05 AG-MPANE1 usage binary-long value 00.
003090 05 AG-MPANE2V usage binary-long value 01.
003100 05 AG-MPANE2H usage binary-long value 02.
003110 05 AG-MPANE2L1R usage binary-long value 03.
003120 05 AG-MPANE1L2R usage binary-long value 04.
003130 05 AG-MPANE2T1B usage binary-long value 05.
003140 05 AG-MPANE1T2B usage binary-long value 06.
003150 05 AG-MPANE3L1R usage binary-long value 07.
003160 05 AG-MPANE1L3R usage binary-long value 08.
003170 05 AG-MPANE3T1B usage binary-long value 09.
003180 05 AG-MPANE1T3B usage binary-long value 10.
003190 05 AG-MPANE4 usage binary-long value 11.
003200
003210 01 notebook-flags.
003220 05 AG-NOTEBOOK-HFILL usage binary-long value h'01'.
003230 05 AG-NOTEBOOK-VFILL usage binary-long value h'02'.
003240 05 AG-NOTEBOOK-HIDE-TABS usage binary-long value h'04'.
003250 05 AG-NOTEBOOK-EXPAND usage binary-long value h'03'.
003260
003270 01 numeri1cal-flags.
003280 05 AG-NUMERICAL-HFILL usage binary-long value h'01'.
003290 05 AG-NUMERICAL-VFILL usage binary-long value h'02'.
003300 05 AG-NUMERICAL-INT usage binary-long value h'04'.
003310 05 AG-NUMERICAL-EXCL usage binary-long value h'08'.
003320 05 AG-NUMERICAL-DEFAULT usage binary-long value h'09'.
003330
003340 01 socket-flags.
003350 05 AG-SOCKET-HFILL usage binary-long value h'01'.
003360 05 AG-SOCKET-VFILL usage binary-long value h'02'.
003370 05 AG-SOCKET-EXPAND usage binary-long value h'03'.
003380 05 AG-SOCKET-MOUSEOVER usage binary-long value h'04'.
003390 05 AG-SOCKET-STICKY_STATE usage binary-long value h'08'.
003400
003410 01 table-flags.
003420 05 AG-TABLE-MULTI usage binary-long value h'001'.
003430 05 AG-TABLE-MULTITOGGLE usage binary-long value h'002'.
003440 05 AG-TABLE-REDRAW-CELLS usage binary-long value h'004'.
003450 05 AG-TABLE-POLL usage binary-long value h'008'.
003460 05 AG-TABLE-HIGHLIGHT-COLS usage binary-long value h'040'.
003470 05 AG-TABLE-WIDGETS usage binary-long value h'080'.
003480 05 AG-TABLE-MULTIMODE usage binary-long value h'003'.
003490 05 AG-TABLE-NOAUTOSORT usage binary-long value h'100'.
003500 05 AG-TABLE-NEEDSORT usage binary-long value h'200'.
003510
003520 01 timer-flags.
003530 05 AG-TIMER-SURVIVE-DETACH usage binary-long value h'01'.
003540 05 AG-TIMER-AUTO-FREE usage binary-long value h'02'.
003550 05 AG-TIMER-EXECD usage binary-long value h'04'.
003560 05 AG-TIMER-RESTART usage binary-long value h'08'.
003570
003580 01 textbox-flags.
003590 05 AG-TEXTBOX-MULTILINE usage binary-long value h'000001'.
003600 05 AG-TEXTBOX-PASSWORD usage binary-long value h'000004'.
003610 05 AG-TEXTBOX-ABANDON-FOCUS usage binary-long value h'000008'.
003620 05 AG-TEXTBOX-COMBO usage binary-long value h'000010'.
003630 05 AG-TEXTBOX-HFILL usage binary-long value h'000020'.
003640 05 AG-TEXTBOX-VFILL usage binary-long value h'000040'.
003650 05 AG-TEXTBOX-EXPAND usage binary-long value h'000030'.
003660 05 AG-TEXTBOX-READONLY usage binary-long value h'000100'.
003670 05 AG-TEXTBOX-INT-ONLY usage binary-long value h'000200'.
003680 05 AG-TEXTBOX-FLT-ONLY usage binary-long value h'000400'.
003690 05 AG-TEXTBOX-CATCH-TAB usage binary-long value h'000800'.
003700 05 AG-TEXTBOX-CURSOR-MOVING usage binary-long value h'001000'.
003710 05 AG-TEXTBOX-EXCL usage binary-long value h'004000'.
003720 05 AG-TEXTBOX-NOEMACS usage binary-long value h'008000'.
003730 05 AG-TEXTBOX-NOLATIN1 usage binary-long value h'020000'.
003740 05 AG-TEXTBOX-WORDWRAP usage binary-long value h'040000'.
003750 05 AG-TEXTBOX-NOPOPUP usage binary-long value h'080000'.
003760 05 AG-TEXTBOX-MULTILINGUAL usage binary-long value h'100000'.
003770 05 AG-TEXTBOX-DEFAULT usage binary-long value h'000000'.
003780
003790 01 treetbl-flags.
003800 05 AG-TREETBL-MULTI usage binary-long value h'001'.
003810 05 AG-TREETBL-MULTITOGGLE usage binary-long value h'002'.
003820 05 AG-TREETBL-REORDERCOLS usage binary-long value h'004'.
003830 05 AG-TREETBL-NODUPCHECKS usage binary-long value h'008'.
003840 05 AG-TREETBL-SORT usage binary-long value h'010'.
003850 05 AG-TREETBL-POLLED usage binary-long value h'020'.
003860 05 AG-TREETBL-HFILL usage binary-long value h'040'.
003870 05 AG-TREETBL-VFILL usage binary-long value h'080'.
003880 05 AG-TREETBL-EXPAND usage binary-long value h'0C0'.
003890
003900
003910*> ***************************************************************
003920*> Networking
003930 01 addr-families.
003940 05 AG-NET-AF-NONE usage binary-long value 0.
003950 05 AG-NET-LOCAL usage binary-long value 1.
003960 05 AG-NET-INET4 usage binary-long value 2.
003970 05 AG-NET-INET6 usage binary-long value 3.
003980
003990 01 socket-types.
004000 05 AG-NET-SOCKET-NONE usage binary-long value 0.
004010 05 AG-NET-STREAM usage binary-long value 1.
004020 05 AG-NET-DGRAM usage binary-long value 2.
004030 05 AG-NET-RAW usage binary-long value 3.
004040 05 AG-NET-RDM usage binary-long value 4.
004050 05 AG-NET-SEQPACKET usage binary-long value 5.
004060
004070 01 socket-poll-flags.
004080 05 AG-NET-POLL-READ usage binary-long value 1.
004090
004100
004110
004120
004130 77 agar-debug pic x(10).
004140 01 stringa pic x(100) value space.
004150 01 tab-numbers.
004160 07 tab-alfa pic x(10).
004170 07 tab-num pic 9(10).
004180
004190
004200 77 local-buffer pic x(10) value space.
004210 77 local-string pic x(100) based.
004220 77 local usage pointer.
004230 copy "global".
004240 procedure division.
004250*set-debug-off
004260 ACCEPT agar-debug from environment "GuiCOBOLdebug".
004270
004280 if agar-started not = agar-true
004290 and agar-function not = "initialize"
004300
004310 perform inizializza thru ex-inizializza.
004320
004330 if function lower-case(agar-local-debug) = "y"
004340 move "enable" to agar-debug.
004350 if function lower-case(agar-local-debug) = "n"
004360 move spaces to agar-debug.
004370
004380
004390 if function lower-case(agar-debug) = "enable"
004400 perform agar-do-debug thru ex-agar-do-debug.
004410
004420
004430
004440 evaluate function lower-case(agar-function)
004450
004460 when "addform" perform addform thru ex-addform
004470 when "show" perform set-visible thru ex-set-visible
004480
004490 when "set-error" perform set-error thru ex-set-error
004500 when "set-warning" perform set-warning thru ex-set-warning
004510 when "set-info" perform set-info thru ex-set-info
004520 when "set-caption" perform set-caption thru ex-set-caption
004530 when "get-caption" perform get-caption thru ex-get-caption
004530 when "get-node" perform get-node thru ex-get-node
004540 when "set-width" perform set-width thru ex-set-width
004550 when "set-height" perform set-height thru ex-set-height
004560 when "get-width" perform get-width thru ex-get-width
004570 when "get-height" perform get-height thru ex-get-height
004580
004590
004600 when "set-top" perform set-top thru ex-set-top
004610 when "set-left" perform set-left thru ex-set-left
004620 when "get-top" perform get-top thru ex-get-top
004630 when "get-left" perform get-left thru ex-get-left
004630 when "get-value" perform get-value thru ex-get-value
004640
004650
004660 when "set-value" perform set-value thru ex-set-value
004670
004680 when "set-position" perform set-position
004690 thru ex-set-position
004700 when "set-disposition" perform set-disposition
004710 thru ex-set-disposition
004720
004730 when "set-visible" perform set-visible thru ex-set-visible
004740 when "set-invisible"
004750 perform set-invisible
004760 thru ex-set-invisible
004770 when "hide" perform set-invisible
004780 thru ex-set-invisible
004790
004800 when "addlabel" perform addlabel thru ex-addlabel
004810 when "addpane" perform addpane thru ex-addpane
004820 when "addprogress" perform addprogress thru ex-addprogress
004830 when "addslider" perform addslider thru ex-addslider
004840 when "addsliderv" perform addsliderv thru ex-addsliderv
004850 when "addscroll" perform addscroll thru ex-addscroll
004860 when "addscrollv" perform addscrollv thru ex-addscrollv
004870 when "addscrollview"
004880 perform addscrollview
004890 thru ex-addscrollview
004900
004910 when "addbutton" perform addbutton thru ex-addbutton
004920 when "addbuttonto" perform addbuttonto thru ex-addbuttonto
004930
004940 when "addcheck" perform addcheck thru ex-addcheck
004950 when "addcheckto" perform addcheckto thru ex-addcheckto
004960
004970 when "additem" perform additem thru ex-additem
004980
004990
005000 when "addtext" perform addtext thru ex-addtext
005010 when "addnumeric" perform addnumeric thru ex-addnumeric
005020 when "addfixed" perform addfixed thru ex-addfixed
005030 when "addcombo" perform addcombo thru ex-addcombo
005040 when "addradio" perform addradio thru ex-addradio
004810 when "addmenu" perform addmenu thru ex-addmenu
004810 when "addnode" perform addnode thru ex-addnode
004810 when "addmenuitem" perform addmenuitem thru ex-addmenuitem
004810 when "addlink" perform addlink thru ex-addlink
005060 when "remove" perform remove thru ex-remove
005060 when "move" perform moveto thru ex-moveto
005070 when "size" perform sizeto thru ex-sizeto
005080 when "set-size" perform sizeto thru ex-sizeto
005090
005100 when "setevent" perform setevent thru ex-setevent
005110 when "addevent" perform addevent thru ex-addevent
005120
005130 when "addbox" perform addbox thru ex-addbox
005140 when "addframe" perform addframe thru ex-addframe
005150
005160 when "get-class" perform get-class thru ex-get-class
005170 when "set-text" perform set-text thru ex-set-text
005180 when "get-text" perform get-text thru ex-get-text
005190
005200 when "set-render" perform set-render thru ex-set-render
005200 when "set-prompt" perform set-prompt thru ex-set-prompt
005210
005220
005230 when "set-name" perform set-name thru ex-set-name
005240 when "get-name" perform get-name thru ex-get-name
005250 when "get-focused" perform get-focused thru ex-get-focused
005240 when "get-cursor" perform get-cursor thru ex-get-cursor
005240 when "set-cursor" perform set-cursor thru ex-set-cursor
005270
005280 when "addproperty" perform addproperty
005290 thru ex-addproperty
005300 when "get-property" perform get-property
005310 thru ex-get-property
005320
005340 when "find" perform find thru ex-find
005350
005360 when "refresh" perform refresh thru ex-refresh
005360 when "disable" perform disableit thru ex-disableit
005360 when "enable" perform enableit thru ex-enableit
005370
005380 when other
005390 display "agarcob - command: '"
005400 function trim(agar-FUNCTION)
005410 "' not yet implemented in agarcob"
005420 upon syserr
005430 end-evaluate.
005440
005450 if function lower-case(agar-debug) = "enable"
005460 perform agar-after-debug thru ex-agar-after-debug.
005470
005480
005490
005500 exit program.
005510
005520 inizializza.
005530
005540 if agar-started not = agar-true
005550
005560 call static "AG_InitCore" using null by value 0 returning rc
00557 * on exception display "error: no libagar " upon syserr
005580 end-call
005590
005600 if rc = -1 then
005610 display "error: AG_InitCore failure" upon syserr
005620 goback
005630 end-if
005640
005650 call "AG_InitGraphics" using by value 0 returning rc
005660 if rc = -1 then
005670 display "error: AG_InitGraphics failure" upon syserr
005680 goback
005690 end-if
005700
005710 move agar-true to agar-started.
005720
005730 set agar-main to null.
005740
005750
005760 ex-inizializza.
005770 exit.
005780
005790 addform.
005800
005810 call "AG_WindowNew" using by value 0 returning agar-object.
005820
005830 if agar-main = null
005840 move agar-object to agar-main.
005850
005860 move agar-object to agar-form.
005870 move "DefaultDestroy" to agar-procedure.
005880 set agar-callback to entry "DefaultDestroy".
005890 move "window-detached" & X"00" to agar-event.
005900 move "setevent" to agar-function.
005910 perform setevent thru ex-setevent.
005920
005930 ex-addform.
005940 exit.
005950
005960 get-focused.
005970
005980 call "AG_WidgetFindFocused"
005990 using by value agar-object returning agar-widget.
006000
006010 ex-get-focused.
006020 exit.
006030
006040 set-visible.
006050
006060 if agar-widget = agar-form
006070 call "AG_WindowShow"
006080 using by value agar-widget returning omitted
006090 go to ex-set-visible.
006100
006110 if agar-debug = "enable"
006120 move "internal get-class" to agar-function
006130 perform agar-do-debug thru ex-agar-do-debug.
006140
006150 perform get-class thru ex-get-class.
006160
006170 if agar-debug = "enable"
006180 perform agar-after-debug thru ex-agar-after-debug.
006190
006200
006210 evaluate agar-class
006220 when "form"
006230
006240 call "AG_WindowShow"
006250 using by value agar-widget returning omitted
006260
006270 when other
006280
006290 call "AG_WidgetShow"
006300 using by value agar-widget returning omitted.
006310
006320 ex-set-visible.
006330 exit.
006340
006350 set-invisible.
006360
006370 perform get-class thru ex-get-class.
006380
006390 evaluate agar-class
006400 when "form"
006410 call "AG_WindowHide"
006420 using by value agar-widget returning omitted
006430
006440 when other
006450 call "AG_WidgetHide"
006460 using by value agar-widget returning omitted.
006470
006480 ex-set-invisible.
006490 exit.
006500
006510 setevent.
006520
006530 move agar-event to agar-text.
006540 perform asciiz thru ex-asciiZ
006550 move agar-text to agar-event.
006560
006570 if agar-callback equal null then
006580 display "windown entry not found:"
006590 function trim(agar-procedure)
006600 else
006610 call "AG_SetEvent" using
006620 by value agar-object
006630 by reference agar-event
006640 by value agar-callback
006650 by reference null
006660 end-if.
006670
006680 set agar-callback to null.
006690 move spaces to agar-procedure.
006700 move spaces to agar-event.
006710
006720 ex-setevent.
006730 exit.
006740
006750 addevent.
006760
006770 move agar-event to agar-text.
006780 perform asciiz thru ex-asciiZ
006790 move agar-text to agar-event.
006800
006810 if agar-callback equal null then
006820 display "windown entry not found:"
006830 function trim(agar-procedure)
006840 else
006850 call "AG_AddEvent" using
006860 by value agar-object
006870 by reference agar-event
006880 by value agar-callback
006890 by reference null
006900 end-if.
006910
006920 set agar-callback to null.
006930 move spaces to agar-procedure.
006940 move spaces to agar-event.
006950
006960 ex-addevent.
006970 exit.
006980
006990
007000 refresh.
007010
007020 if agar-debug = "enable"
007030 move "internal get-class" to agar-function
007040 perform agar-do-debug thru ex-agar-do-debug.
007050
007060
007070 perform get-class thru ex-get-class.
007080
007090 evaluate agar-class
007100 when "form"
007110 CALL static "AG_WindowUpdate"
007120 using by value agar-object
007130 returning omitted
007140
007150 when other
007160
007170 CALL STATIC "ag_widget_update"
007180 using by value agar-object
007190 returning omitted
007200 end-evaluate.
007210
007220
007230 ex-refresh.
007240 exit.
007000 enableit.
007010
007020 if agar-debug = "enable"
007030 move "internal get-class" to agar-function
007040 perform agar-do-debug thru ex-agar-do-debug.
007050
007060
007070 perform get-class thru ex-get-class.
007080
007090 evaluate agar-class
007100 when "menu"
007110 CALL static "AG_MenuState"
007120 using by value agar-object
by value 1
007140
007150 when other
007160
call static "AG_WidgetEnable"
007180 using by value agar-object
007200 end-evaluate.
007210
007220
007230 ex-enableit.
007240 exit.
007000 disableit.
007010
007020 if agar-debug = "enable"
007030 move "internal get-class" to agar-function
007040 perform agar-do-debug thru ex-agar-do-debug.
007050
007060
007070 perform get-class thru ex-get-class.
007080
007090 evaluate agar-class
007100 when "menu"
007110 CALL static "AG_MenuState"
007120 using by value agar-object
by value 0
007140
007150 when other
007160
call static "AG_WidgetDisable"
007180 using by value agar-object
007200 end-evaluate.
007210
007220
007230 ex-disableit.
007240 exit.
007250
007260 set-value.
007270
007280 if agar-debug = "enable"
007290 move "internal get-class" to agar-function
007300 perform agar-do-debug thru ex-agar-do-debug.
007310
007320 perform get-class thru ex-get-class.
007330
007340 if agar-debug = "enable"
007350 perform agar-after-debug thru ex-agar-after-debug.
007360
007370 move "set-value" to agar-function
007380
007390 evaluate agar-class
007400 when "progress"
007410
007420
007430 call "AG_BindInt" using
007440 by value agar-object
007450 by reference z"value"
007460 by reference agar-int
007470 end-call
007480
007490 when "check"
007500
007510 call "AG_CheckboxSetState" using
007520 by value
007530 agar-object
007540 by value
007550 agar-int
007560 end-call
007570
007580 when other display " agar-class" agar-class
007590 end-evaluate.
007600
007610
007620 ex-set-value.
007630 exit.
007640
007650 get-value.
007660
007670 if agar-debug = "enable"
007680 move "internal get-class" to agar-function
007690 perform agar-do-debug thru ex-agar-do-debug.
007700
007710 perform get-class thru ex-get-class.
007720
007730 if agar-debug = "enable"
007740 perform agar-after-debug thru ex-agar-after-debug.
007750
007760 move "get-value" to agar-function
007770
007780 evaluate agar-class
007790
007800 when "check"
007810
007820 call static "AG_CheckboxGetState" using
007830 by value
007840 agar-object
007850 returning
007860 agar-int
007870 end-call
007880
007890
007900
007910 when other display "class in get value:" agar-class
007920 end-evaluate.
007930
007940 ex-get-value.
007950 exit.
007960
007970 set-caption.
007980
007990 perform asciiZ thru ex-asciiZ.
008000
008010 if agar-debug = "enable"
008020 move "internal get-class" to agar-function
008030 perform agar-do-debug thru ex-agar-do-debug.
008040
008050
008060
008070 perform get-class thru ex-get-class.
008080
008090 if agar-debug = "enable"
008100 perform agar-after-debug thru ex-agar-after-debug.
008110
008120 move "set-caption" to agar-function
008130
008140 evaluate agar-class
008150 when "form"
008160
008170 move agar-form to agar-object
008180
008190 CALL "AG_WindowSetCaptionS"
008200 using by value agar-object
008210 by reference agar-text
008220
008230 when "box"
008240
008250 call static "AG_BoxSetLabelS" using by value
008260 agar-object
008270 by reference agar-text
008280
008290 when "label"
008300
008310 call static "AG_LabelText" using by value
008320 agar-object
008330 by reference agar-text
008340
008350 when "text"
008360
008370 call static "AG_TextboxSetLabelS" using by value
008380 agar-object
008390 by reference agar-text
008400
008410 when "button"
008420 call static "AG_ButtonText" using by value
008430 agar-object
008440 by reference agar-text
008410 when "menu"
call "AG_MenuSetLabel"
using by value agar-object
008440 by reference agar-text
008450
008460 WHEN other
008470
008480 DISPLAY "caption is not defined for"
008490 function trim(agar-class) upon syserr
008500
008510 end-evaluate.
008520
008530
008540 move agar-text to agar-value
008550
008560 call "AG_SetString" using
008570 by value agar-object
008580 by reference z"caption"
008590 by reference agar-value
008600 returning omitted.
008610
008620
008630 ex-set-caption.
008640 exit.
008650
008660
008670
008680 addbox.
008690
008700 call static "AG_BoxNewHoriz" using
008710 by value agar-object
008720 BY VALUE 10
008730* by value AG-BOX-HFILL
008740* by value AG-BOX-HOMOGENOUS
008750* by value AG-BOX-HOMOGENOUS
008760* by value AG-BOX-HFILL
008770* by value AG-BOX-VFILL
008780* by value AG-BOX-FRAME
008790
008800 returning agar-widget.
008810
008820 ex-addbox.
008830 exit.
008840
008850 addframe.
008860
008870 call static "AG_BoxNewVert" using
008880 by value agar-object
008890 BY VALUE 12
008900* by value AG-BOX-HOMOGENOUS
008910* by value AG-BOX-HOMOGENOUS
008920* by value AG-BOX-HFILL
008930* by value AG-BOX-VFILL
008940* by value AG-BOX-FRAME
008950
008960 returning agar-widget.
008970
008980 ex-addframe.
008990 exit.
009000
009010
009020
009030 addlabel.
009040
009050 PERFORM asciiZ thru ex-asciiz.
009060
009070* call static "AG_LabelNew" using
009080 call "AG_LabelNew" using
009090 by value agar-object 0
009100 by reference agar-text
009110 returning agar-widget.
009120
009130 call static "AG_LabelSizeHint"
009140 using by value agar-widget
009150 by reference agar-text.