1#!/usr/bin/perl 2 3use warnings; 4use strict; 5 6sub write_byte { 7 8 my( $b ) = @_; 9 10 printf "%c", $b; 11} 12 13sub write_word { 14 15 my( $w ) = @_; 16 17 write_byte( $w % 0x100 ); 18 write_byte( $w / 0x100 ); 19} 20 21sub write_three { 22 23 my( $three ) = @_; 24 25 write_byte( $three % 0x100 ); 26 write_word( $three / 0x100 ); 27 28} 29 30sub write_dword { 31 32 my( $dw ) = @_; 33 34 write_word( $dw % 0x10000 ); 35 write_word( $dw / 0x10000 ); 36} 37 38sub write_header { 39 40 print "ZXTape!\x1a"; # Signature 41 write_byte( 1 ); # Major version number 42 write_byte( 20 ); # Minor version number 43 44} 45 46sub write_standard_speed_data_block { 47 48 my( $data, $pause ) = @_; 49 50 write_byte( 0x10 ); 51 write_word( $pause ); 52 write_word( length $data ); 53 print $data; 54 55} 56 57sub write_turbo_speed_data_block { 58 59 my( $pilot_length, $pilot_count, $sync1_length, $sync2_length, 60 $zero_length, $one_length, $data, $bits_in_last_byte, $pause ) = @_; 61 62 write_byte( 0x11 ); 63 write_word( $pilot_length ); 64 write_word( $sync1_length ); 65 write_word( $sync2_length ); 66 write_word( $zero_length ); 67 write_word( $one_length ); 68 write_word( $pilot_count ); 69 write_byte( $bits_in_last_byte ); 70 write_word( $pause ); 71 write_three( length $data ); 72 print $data; 73 74} 75 76sub write_pure_tone_block { 77 78 my( $length, $count ) = @_; 79 80 write_byte( 0x12 ); 81 write_word( $length ); 82 write_word( $count ); 83 84} 85 86sub write_pulse_sequence_block { 87 88 my( @data ) = @_; 89 90 write_byte( 0x13 ); 91 write_byte( scalar @data ); 92 write_word( $_ ) foreach @data; 93 94} 95 96sub write_pure_data_block { 97 98 my( $zero_length, $one_length, $data, $bits_in_last_byte, $pause ) = @_; 99 100 write_byte( 0x14 ); 101 write_word( $zero_length ); 102 write_word( $one_length ); 103 write_byte( $bits_in_last_byte ); 104 write_word( $pause ); 105 write_three( length $data ); 106 print $data; 107 108} 109 110sub write_pause_block { 111 112 my( $pause ) = @_; 113 114 write_byte( 0x20 ); 115 write_word( $pause ); 116 117} 118 119sub write_group_start_block { 120 121 my( $name ) = @_; 122 123 write_byte( 0x21 ); 124 write_byte( length $name ); 125 print $name; 126 127} 128 129sub write_group_end_block { 130 131 my( $name ) = @_; 132 133 write_byte( 0x22 ); 134 135} 136 137sub write_jump_block { 138 139 my( $offset ) = @_; 140 141 write_byte( 0x23 ); 142 write_word( $offset ); 143 144} 145 146sub write_loop_start_block { 147 148 my( $iterations ) = @_; 149 150 write_byte( 0x24 ); 151 write_word( $iterations ); 152 153} 154 155sub write_loop_end_block { 156 157 write_byte( 0x25 ); 158 159} 160 161sub write_stop_tape_if_in_48k_mode_block { 162 163 write_byte( 0x2a ); 164 write_dword( 0 ); 165 166} 167 168sub write_text_description_block { 169 170 my( $text ) = @_; 171 172 write_byte( 0x30 ); 173 write_byte( length $text ); 174 print $text; 175 176} 177 178sub write_message_block { 179 180 my( $text, $time ) = @_; 181 182 write_byte( 0x31 ); 183 write_byte( $time ); 184 write_byte( length $text ); 185 print $text; 186 187} 188 189sub write_archive_info_block { 190 191 my( @strings ) = @_; 192 193 write_byte( 0x32 ); 194 195 my $data; 196 197 foreach my $string ( @strings ) { 198 $data .= chr( $string->{id} ); 199 $data .= chr( length $string->{text} ); 200 $data .= $string->{text}; 201 } 202 203 write_word( length $data ); 204 write_byte( scalar @strings ); 205 print $data; 206 207} 208 209sub write_hardware_type_block { 210 211 my( @info ) = @_; 212 213 write_byte( 0x33 ); 214 write_byte( scalar @info ); 215 216 foreach my $info ( @info ) { 217 write_byte( $info->{type} ); 218 write_byte( $info->{id} ); 219 write_byte( $info->{used} ); 220 } 221} 222 223sub write_custom_info_block { 224 225 my( $id, $data ) = @_; 226 227 write_byte( 0x35 ); 228 229 if( length $id < 16 ) { 230 $id .= ' ' x ( 16 - length $id ); 231 } elsif( length $id > 16 ) { 232 $id = substr( $id, 0, 16 ); 233 } 234 print $id; 235 write_dword( length $data ); 236 print $data; 237 238} 239 240write_header(); 241 242write_standard_speed_data_block( "\xaa", 2345 ); 243 244write_turbo_speed_data_block( 1000, 5, 123, 456, 789, 400, "\x00\xff\x55\xa0", 245 4, 987 ); 246 247write_pure_tone_block( 535, 666 ); 248 249write_pulse_sequence_block( 772, 297, 692 ); 250 251write_pure_data_block( 552, 1639, "\xff\x00\xfc", 6, 554 ); 252 253write_pause_block( 618 ); 254 255write_group_start_block( "Group Start" ); 256 257write_group_end_block(); 258 259write_jump_block( 2 ); 260 261write_pure_tone_block( 303, 678 ); 262 263write_loop_start_block( 3 ); 264 265write_pure_tone_block( 837, 185 ); 266 267write_loop_end_block(); 268 269write_stop_tape_if_in_48k_mode_block(); 270 271write_text_description_block( "Comment here" ); 272 273write_message_block( "A message", 1 ); 274 275write_archive_info_block( { id => 0x00, text => "Full title" }, 276 { id => 0x03, text => "Year" } ); 277 278write_hardware_type_block( { type => 0x00, id => 0x01, used => 0x00 }, 279 { type => 0x02, id => 0x02, used => 0x03 } ); 280 281write_custom_info_block( "Complete TZX", "Arbitrary custom data" ); 282 283write_pure_tone_block( 820, 941 ); 284