diff --git a/lib/adc.c b/lib/adc.c index 33938be..da4bcfc 100644 --- a/lib/adc.c +++ b/lib/adc.c @@ -27,7 +27,7 @@ uint8_t adc_read_byte(uint8_t channel) sbi(ADMUX, ADLAR); // Align result to left sbi(ADCSRA, ADSC); // Start conversion - while(bit_is_high(ADCSRA, ADSC)); // Wait for it... + while (bit_is_high(ADCSRA, ADSC)); // Wait for it... return ADCH; // The upper 8 bits of ADC result } @@ -40,7 +40,7 @@ uint16_t adc_read_word(uint8_t channel) cbi(ADMUX, ADLAR); // Align result to right sbi(ADCSRA, ADSC); // Start conversion - while(get_bit(ADCSRA, ADSC)); // Wait for it... + while (get_bit(ADCSRA, ADSC)); // Wait for it... return ADCW; // The whole ADC word (10 bits) } diff --git a/lib/color.c b/lib/color.c index 101613e..ef7b0bb 100644 --- a/lib/color.c +++ b/lib/color.c @@ -10,16 +10,17 @@ // --- HSL --- #ifdef HSL_LINEAR - const uint8_t FADE_128[] = { - 0, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3, 3, 3, 4, 4, 4, 4, - 5, 5, 6, 6, 6, 7, 7, 8, 8, 8, 9, 10, 10, 10, 11, 12, 13, 14, - 14, 15, 16, 17, 18, 20, 21, 22, 24, 26, 27, 28, 30, 31, 32, 34, 35, 36, - 38, 39, 40, 41, 42, 44, 45, 46, 48, 49, 50, 52, 54, 56, 58, 59, 61, 63, - 65, 67, 68, 69, 71, 72, 74, 76, 78, 80, 82, 85, 88, 90, 92, 95, 98, 100, - 103, 106, 109, 112, 116, 119, 122, 125, 129, 134, 138, 142, 147, 151, - 153, 156, 160, 163, 165, 170, 175, 180, 185, 190, 195, 200, 207, 214, 218, - 221, 225, 228, 232, 234, 241, 248, 254, 255 - }; +const uint8_t FADE_128[] = +{ + 0, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 3, 3, 3, 4, 4, 4, 4, + 5, 5, 6, 6, 6, 7, 7, 8, 8, 8, 9, 10, 10, 10, 11, 12, 13, 14, + 14, 15, 16, 17, 18, 20, 21, 22, 24, 26, 27, 28, 30, 31, 32, 34, 35, 36, + 38, 39, 40, 41, 42, 44, 45, 46, 48, 49, 50, 52, 54, 56, 58, 59, 61, 63, + 65, 67, 68, 69, 71, 72, 74, 76, 78, 80, 82, 85, 88, 90, 92, 95, 98, 100, + 103, 106, 109, 112, 116, 119, 122, 125, 129, 134, 138, 142, 147, 151, + 153, 156, 160, 163, 165, 170, 175, 180, 185, 190, 195, 200, 207, 214, 218, + 221, 225, 228, 232, 234, 241, 248, 254, 255 +}; #endif // based on: https://github.com/lewisd32/avr-hsl2rgb @@ -30,19 +31,26 @@ xrgb_t hsl_xrgb(const hsl_t cc) const uint8_t hue_mod = hh % 256; uint8_t r_temp, g_temp, b_temp; - if (hh < 256) { + if (hh < 256) + { r_temp = hue_mod ^ 255; g_temp = hue_mod; b_temp = 0; - } else if (hh < 512) { + } + else if (hh < 512) + { r_temp = 0; g_temp = hue_mod ^ 255; b_temp = hue_mod; - } else if (hh < 768) { + } + else if (hh < 768) + { r_temp = hue_mod; g_temp = 0; b_temp = hue_mod ^ 255; - } else { + } + else + { r_temp = 0; g_temp = 0; b_temp = 0; @@ -56,7 +64,7 @@ xrgb_t hsl_xrgb(const hsl_t cc) uint16_t t16; #ifdef HSL_LINEAR - const uint8_t bri = FADE_128[cc.l>>1]; + const uint8_t bri = FADE_128[cc.l >> 1]; #else const uint8_t bri = cc.l; #endif diff --git a/lib/color.h b/lib/color.h index 716f738..7fef13a 100644 --- a/lib/color.h +++ b/lib/color.h @@ -12,7 +12,8 @@ // Define HSL_LINEAR to get more linear brightness in hsl->rgb conversion -typedef struct { +typedef struct +{ uint8_t r; uint8_t g; uint8_t b; @@ -45,7 +46,8 @@ typedef uint32_t rgb24_t; // HSL data structure -typedef struct { +typedef struct +{ uint8_t h; uint8_t s; uint8_t l; diff --git a/lib/debounce.c b/lib/debounce.c index 0e6e803..a2f422a 100644 --- a/lib/debounce.c +++ b/lib/debounce.c @@ -11,11 +11,11 @@ uint8_t debo_next_slot = 0; uint8_t debo_register(PORT_P reg, uint8_t bit, bool invert) { - debo_slots[debo_next_slot] = (debo_slot_t){ + debo_slots[debo_next_slot] = (debo_slot_t)({ .reg = reg, .bit = bit | ((invert & 1) << 7) | (get_bit_p(reg, bit) << 6), // bit 7 = invert, bit 6 = state .count = 0, - }; + }); return debo_next_slot++; } @@ -24,21 +24,28 @@ uint8_t debo_register(PORT_P reg, uint8_t bit, bool invert) /** Check debounced pins, should be called periodically. */ void debo_tick() { - for (uint8_t i = 0; i < debo_next_slot; i++) { + for (uint8_t i = 0; i < debo_next_slot; i++) + { // current pin value (right 3 bits, xored with inverse bit) bool value = get_bit_p(debo_slots[i].reg, debo_slots[i].bit & 0x7); - if (value != get_bit(debo_slots[i].bit, 6)) { + if (value != get_bit(debo_slots[i].bit, 6)) + { // different pin state than last recorded state - if (debo_slots[i].count < DEBO_TICKS) { + if (debo_slots[i].count < DEBO_TICKS) + { debo_slots[i].count++; - } else { + } + else + { // overflown -> latch value set_bit(debo_slots[i].bit, 6, value); // set state bit debo_slots[i].count = 0; } - } else { + } + else + { debo_slots[i].count = 0; // reset the counter } } diff --git a/lib/debounce.h b/lib/debounce.h index 918111d..42ea71c 100644 --- a/lib/debounce.h +++ b/lib/debounce.h @@ -31,7 +31,7 @@ #include #include "calc.h" -#include "pins.h" +#include "iopins.h" // Your config file #include "debo_config.h" @@ -42,7 +42,8 @@ /* Internal deboucer entry */ -typedef struct { +typedef struct +{ PORT_P reg; // pointer to IO register uint8_t bit; // bits 6 and 7 of this hold "state" & "invert" flag uint8_t count; // number of ticks this was in the new state diff --git a/lib/dht11.h b/lib/dht11.h index 53300e3..47409d5 100644 --- a/lib/dht11.h +++ b/lib/dht11.h @@ -7,7 +7,8 @@ #include #include -typedef struct { +typedef struct +{ int8_t temp; int8_t rh; } dht11_result_t; diff --git a/lib/fat16.c b/lib/fat16.c new file mode 100644 index 0000000..c4f9f63 --- /dev/null +++ b/lib/fat16.c @@ -0,0 +1,1180 @@ +#include +#include +#include + +#include "fat16.h" + + + +// ============== INTERNAL PROTOTYPES ================== + +/** Read boot sector from given address */ +void read_bs(const BLOCKDEV* dev, Fat16BootSector* info, const uint32_t addr); + +/** Find absolute address of first BootSector. Returns 0 on failure. */ +uint32_t find_bs(const BLOCKDEV* dev); + +/** Get cluster's starting address */ +uint32_t clu_addr(const FAT16* fat, const uint16_t cluster); + +/** Find following cluster using FAT for jumps */ +uint16_t next_clu(const FAT16* fat, uint16_t cluster); + +/** Find relative address in a file, using FAT for cluster lookup */ +uint32_t clu_offs(const FAT16* fat, uint16_t cluster, uint32_t addr); + +/** Read a file entry from directory (dir starting cluster, entry number) */ +void open_file(const FAT16* fat, FAT16_FILE* file, const uint16_t dir_cluster, const uint16_t num); + +/** Allocate and chain new cluster to a chain starting at given cluster */ +bool append_cluster(const FAT16* fat, const uint16_t clu); + +/** Allocate a new cluster, clean it, and mark with 0xFFFF in FAT */ +uint16_t alloc_cluster(const FAT16* fat); + +/** Zero out entire cluster. */ +void wipe_cluster(const FAT16* fat, const uint16_t clu); + +/** Free cluster chain, starting at given number */ +bool free_cluster_chain(const FAT16* fat, uint16_t clu); + +/** + * Check if there is already a file of given RAW name + * Raw name - name as found on disk, not "display name". + */ +bool dir_find_file_raw(FAT16_FILE* dir, const char* fname); + +/** Write a value into FAT */ +void write_fat(const FAT16* fat, const uint16_t cluster, const uint16_t value); + +/** Read a value from FAT */ +uint16_t read_fat(const FAT16* fat, const uint16_t cluster); + + +// =========== INTERNAL FUNCTION IMPLEMENTATIONS ========= + + +uint16_t read16(const BLOCKDEV* dev) +{ + uint16_t a; + dev->load(&a, 2); + return a; +} + + +void write16(const BLOCKDEV* dev, const uint16_t val) +{ + dev->store(&val, 2); +} + +/** Find absolute address of first boot sector. Returns 0 on failure. */ +uint32_t find_bs(const BLOCKDEV* dev) +{ + // Reference structure: + // + // typedef struct __attribute__((packed)) { + // uint8_t first_byte; + // uint8_t start_chs[3]; + // uint8_t partition_type; + // uint8_t end_chs[3]; + // uint32_t start_sector; + // uint32_t length_sectors; + // } PartitionTable; + + uint16_t addr = 0x1BE + 4; // fourth byte of structure is the type. + uint32_t tmp = 0; + uint16_t tmp2; + + for (uint8_t i = 0; i < 4; i++, addr += 16) + { + // Read partition type + dev->seek(addr); + tmp = dev->read(); + + // Check if type is valid + if (tmp == 4 || tmp == 6 || tmp == 14) + { + // read MBR address + dev->rseek(3);// skip 3 bytes + dev->load(&tmp, 4); + + tmp = tmp << 9; // multiply address by 512 (sector size) + + // Verify that the boot sector has a valid signature mark + dev->seek(tmp + 510); + dev->load(&tmp2, 2); + if (tmp2 != 0xAA55) continue; // continue to next entry + + // return absolute MBR address + return tmp; + } + } + + return 0; +} + + +/** Read the boot sector */ +void read_bs(const BLOCKDEV* dev, Fat16BootSector* info, const uint32_t addr) +{ + dev->seek(addr + 13); // skip 13 + + dev->load(&(info->sectors_per_cluster), 6); // spc, rs, nf, re + + info->total_sectors = 0; + dev->load(&(info->total_sectors), 2); // short sectors + + dev->rseek(1); // md + + dev->load(&(info->fat_size_sectors), 2); + + dev->rseek(8); // spt, noh, hs + + // read or skip long sectors field + if (info->total_sectors == 0) + { + dev->load(&(info->total_sectors), 4); + } + else + { + dev->rseek(4); // tsl + } + + dev->rseek(7); // dn, ch, bs, vi + + dev->load(&(info->volume_label), 11); +} + + +void write_fat(const FAT16* fat, const uint16_t cluster, const uint16_t value) +{ + fat->dev->seek(fat->fat_addr + (cluster * 2)); + write16(fat->dev, value); +} + + +uint16_t read_fat(const FAT16* fat, const uint16_t cluster) +{ + fat->dev->seek(fat->fat_addr + (cluster * 2)); + return read16(fat->dev); +} + + +/** Get cluster starting address */ +uint32_t clu_addr(const FAT16* fat, const uint16_t cluster) +{ + if (cluster < 2) return fat->rd_addr; + return fat->data_addr + (cluster - 2) * fat->bs.bytes_per_cluster; +} + + +uint16_t next_clu(const FAT16* fat, uint16_t cluster) +{ + return read_fat(fat, cluster); +} + + +/** Find file-relative address in fat table */ +uint32_t clu_offs(const FAT16* fat, uint16_t cluster, uint32_t addr) +{ + while (addr >= fat->bs.bytes_per_cluster) + { + cluster = next_clu(fat, cluster); + if (cluster == 0xFFFF) return 0xFFFF; // fail + addr -= fat->bs.bytes_per_cluster; + } + + return clu_addr(fat, cluster) + addr; +} + + +/** + * Zero out entire cluster + * This is important only for directory clusters, so we can + * zero only every first byte of each file entry, to indicate + * that it is unused (FT_NONE). + */ +void wipe_cluster(const FAT16* fat, const uint16_t clu) +{ + uint32_t addr = clu_addr(fat, clu); + + const BLOCKDEV* dev = fat->dev; + + dev->seek(addr); + + for (uint32_t b = 0; b < fat->bs.bytes_per_cluster; b += 32) + { + dev->write(0); + dev->rseek(32); + } +} + + +/** Allocate a new cluster, clean it, and mark with 0xFFFF in FAT */ +uint16_t alloc_cluster(const FAT16* fat) +{ + // find new unclaimed cluster that can be added to the chain. + uint16_t i, b; + for (i = 2; i < fat->bs.fat_size_sectors * 256; i++) + { + // read value from FAT + b = read_fat(fat, i); + if (b == 0) // unused cluster + { + // Write FFFF to "i", to mark end of file + write_fat(fat, i, 0xFFFF); + + // Wipe the cluster + wipe_cluster(fat, i); + + return i; + } + } + + return 0xFFFF;//error code +} + + +/** Allocate and chain new cluster to a chain starting at given cluster */ +bool append_cluster(const FAT16* fat, const uint16_t clu) +{ + uint16_t clu2 = alloc_cluster(fat); + if (clu2 == 0xFFFF) return false; + + // Write "i" to "clu" + write_fat(fat, clu, clu2); + + return true; +} + + +bool free_cluster_chain(const FAT16* fat, uint16_t clu) +{ + if (clu < 2) return false; + + do + { + // get address of the next cluster + const uint16_t clu2 = read_fat(fat, clu); + + // mark cluster as unused + write_fat(fat, clu, 0x0000); + + // advance + clu = clu2; + } + while (clu != 0xFFFF); + + return true; +} + + +/** + * Check if there is already a file of given RAW name + * Raw name - name as found on disk, not "display name". + */ +bool dir_find_file_raw(FAT16_FILE* dir, const char* fname) +{ + // rewind + fat16_first(dir); + + do + { + bool diff = false; + for (uint8_t i = 0; i < 11; i++) + { + if (dir->name[i] != fname[i]) + { + diff = true; + break; + } + } + + // found the right file? + if (!diff) + { + return true; // file is already open. + } + } + while (fat16_next(dir)); + + return false; +} + + +/** + * Read a file entry + * + * dir_cluster ... directory start cluster + * num ... entry number in the directory + */ +void open_file(const FAT16* fat, FAT16_FILE* file, const uint16_t dir_cluster, const uint16_t num) +{ + // Resolve starting address + uint32_t addr; + if (dir_cluster == 0) + { + addr = clu_addr(fat, dir_cluster) + num * 32; // root directory, max 512 entries. + } + else + { + addr = clu_offs(fat, dir_cluster, num * 32); // cluster + N (wrapping to next cluster if needed) + } + + fat->dev->seek(addr); + fat->dev->load(file, 12); // name, ext, attribs + fat->dev->rseek(14); // skip 14 bytes + fat->dev->load(((void*)file) + 12, 6); // read remaining bytes + + file->clu = dir_cluster; + file->num = num; + + // add a FAT pointer + file->fat = fat; + + // Resolve filename & type + + file->type = FT_FILE; + + const uint8_t c = file->name[0]; + switch (c) + { + case 0x00: + file->type = FT_NONE; + return; + + case 0xE5: + file->type = FT_DELETED; + return; + + case 0x05: // Starting with 0xE5 + file->type = FT_FILE; + file->name[0] = 0xE5; // convert to the real character + break; + + case 0x2E: + if (file->name[1] == 0x2E) + { + // ".." directory + file->type = FT_PARENT; + } + else + { + // "." directory + file->type = FT_SELF; + } + break; + + default: + if (c < 32) + { + file->type = FT_INVALID; // File is corrupt, treat it as invalid + return; // avoid trying to seek + } + else + { + file->type = FT_FILE; + } + } + + // handle subdir, label + if (file->attribs & FA_DIR && file->type == FT_FILE) + { + file->type = FT_SUBDIR; + } + else if (file->attribs == FA_LABEL) + { + file->type = FT_LABEL; // volume label special file + return; // do not seek + } + else if (file->attribs == 0x0F) + { + file->type = FT_LFN; // long name special file, can be ignored + return; // do not seek + } + + // Init cursors + fat16_seek(file, 0); +} + + + +/** + * Write information into a file header. + * "file" is an open handle. + */ +void write_file_header(FAT16_FILE* file, const char* fname_raw, const uint8_t attribs, const uint16_t clu_start) +{ + const BLOCKDEV* dev = file->fat->dev; + + const uint32_t entrystart = clu_offs(file->fat, file->clu, file->num * 32); + + // store the file name + dev->seek(entrystart); + dev->store(fname_raw, 11); + + // attributes + dev->write(attribs); + + // 10 reserved, 2+2 date & time + // (could just skip, but better to fill with zeros) + for (uint8_t i = 0; i < 14; i++) + { + dev->write(0); + } + + // addr of the first file cluster + write16(dev, clu_start); + + // file size (uint32_t) + write16(dev, 0); + write16(dev, 0); + + // reopen file - load & parse the information just written + open_file(file->fat, file, file->clu, file->num); +} + + + +// =============== PUBLIC FUNCTION IMPLEMENTATIONS ================= + +/** Initialize a FAT16 handle */ +void fat16_init(const BLOCKDEV* dev, FAT16* fat) +{ + const uint32_t bs_a = find_bs(dev); + fat->dev = dev; + read_bs(dev, &(fat->bs), bs_a); + fat->fat_addr = bs_a + (fat->bs.reserved_sectors * 512); + fat->rd_addr = bs_a + (fat->bs.reserved_sectors + fat->bs.fat_size_sectors * fat->bs.num_fats) * 512; + fat->data_addr = fat->rd_addr + (fat->bs.root_entries * 32); // entry is 32B long + + fat->bs.bytes_per_cluster = (fat->bs.sectors_per_cluster * 512); +} + + +/** + * Move file cursor to a position relative to file start + * Allows seek past end of file, will allocate new cluster if needed. + */ +bool fat16_seek(FAT16_FILE* file, uint32_t addr) +{ + const FAT16* fat = file->fat; + + // Store as rel + file->cur_rel = addr; + + // Rewind and resolve abs, clu, ofs + file->cur_clu = file->clu_start; + + while (addr >= fat->bs.bytes_per_cluster) + { + uint32_t next; + + // Go to next cluster, allocate if needed + do + { + next = next_clu(fat, file->cur_clu); + if (next == 0xFFFF) + { + // reached end of allocated space + // add one more cluster + if (!append_cluster(fat, file->cur_clu)) + { + return false; + } + } + } + while (next == 0xFFFF); + + file->cur_clu = next; + addr -= fat->bs.bytes_per_cluster; + } + + file->cur_abs = clu_addr(fat, file->cur_clu) + addr; + file->cur_ofs = addr; + + // Physically seek to that location + fat->dev->seek(file->cur_abs); + + return true; +} + + +/** + * Check if file is a regular file or directory entry. + * Those files can be shown to user. + */ +bool fat16_is_regular(const FAT16_FILE* file) +{ + switch (file->type) + { + case FT_FILE: + case FT_SUBDIR: + case FT_SELF: + case FT_PARENT: + return true; + + default: + return false; + } +} + + +#define MIN(a, b) (((a) < (b)) ? (a) : (b)) + +bool fat16_read(FAT16_FILE* file, void* target, uint32_t len) +{ + if (file->cur_abs == 0xFFFF) + return false; // file at the end already + + if (file->cur_rel + len > file->size) + return false; // Attempt to read more than what is available + + const FAT16* fat = file->fat; + const BLOCKDEV* dev = fat->dev; + + while (len > 0 && file->cur_rel < file->size) + { + // How much can be read from the cluster + uint16_t chunk = MIN(file->size - file->cur_rel, MIN(fat->bs.bytes_per_cluster - file->cur_ofs, len)); + + // read the chunk + dev->seek(file->cur_abs); + dev->load(target, chunk); + + // move the cursors + file->cur_abs += chunk; + file->cur_rel += chunk; + file->cur_ofs += chunk; + + // move target pointer + target += chunk; + + // reached end of cluster? + if (file->cur_ofs >= fat->bs.bytes_per_cluster) + { + file->cur_clu = next_clu(fat, file->cur_clu); + file->cur_abs = clu_addr(fat, file->cur_clu); + file->cur_ofs = 0; + } + + // subtract read length + len -= chunk; + } + + return true; +} + + +bool fat16_write(FAT16_FILE* file, void* source, uint32_t len) +{ + const FAT16* fat = file->fat; + const BLOCKDEV* dev = fat->dev; + + + if (file->cur_abs == 0xFFFF) + return false; // file at the end already + + // Attempt to write past end of file + if (file->cur_rel + len >= file->size) + { + const uint32_t pos_start = file->cur_rel; + + // Seek to the last position + // -> fseek will allocate clusters + if (!fat16_seek(file, pos_start + len)) + return false; // error in seek + + // Write starts beyond EOF - creating a zero-filled "hole" + if (file->cur_rel > file->size) + { + // Seek to the end of valid data + fat16_seek(file, file->size); + + // fill space between EOF and start-of-write with zeros + uint32_t fill = pos_start - file->size; + + // repeat until all "fill" zeros are stored + while (fill > 0) + { + // How much will fit into this cluster + const uint16_t chunk = MIN(fat->bs.bytes_per_cluster - file->cur_ofs, fill); + + // write the zeros + dev->seek(file->cur_abs); + for (uint16_t i = 0; i < chunk; i++) + { + dev->write(0); + } + + // subtract from "needed" what was just placed + fill -= chunk; + + // advance cursors to the next cluster + file->cur_clu = next_clu(fat, file->cur_clu); + file->cur_abs = clu_addr(fat, file->cur_clu); + file->cur_ofs = 0; + } + } + + // Save new size + fat16_resize(file, pos_start + len); + + // Seek back to where it was before + fat16_seek(file, pos_start); + } // (end zerofill) + + + // write the data + while (len > 0) + { + // How much can be stored in this cluster + const uint16_t chunk = MIN(fat->bs.bytes_per_cluster - file->cur_ofs, len); + + // store the chunk + dev->seek(file->cur_abs); + dev->store(source, chunk); + + // advance cursors + file->cur_abs += chunk; + file->cur_rel += chunk; + file->cur_ofs += chunk; + + // Pointer arith! + source += chunk; // advance the source pointer + + // detect cluster overflow + if (file->cur_ofs >= fat->bs.bytes_per_cluster) + { + // advance to following cluster + file->cur_clu = next_clu(fat, file->cur_clu); + file->cur_abs = clu_addr(fat, file->cur_clu); + file->cur_ofs = 0; + } + + // subtract written length + len -= chunk; + } + + return true; +} + + + +/** Open next file in the directory */ +bool fat16_next(FAT16_FILE* file) +{ + const FAT16* fat = file->fat; + const BLOCKDEV* dev = fat->dev; + + if (file->clu == 0 && file->num >= fat->bs.root_entries) + return false; // attempt to read outside root directory. + + const uint32_t addr = clu_offs(fat, file->clu, (file->num + 1) * 32); + if (addr == 0xFFFF) + return false; // next file is out of the directory cluster + + // read first byte of the file entry + dev->seek(addr); + if (dev->read() == 0) + return false; // can't read (file is NONE) + + open_file(fat, file, file->clu, file->num + 1); + + return true; +} + + +/** Open previous file in the directory */ +bool fat16_prev(FAT16_FILE* file) +{ + if (file->num == 0) + return false; // first file already + + open_file(file->fat, file, file->clu, file->num - 1); + + return true; +} + + +/** Rewind to first file in directory */ +void fat16_first(FAT16_FILE* file) +{ + open_file(file->fat, file, file->clu, 0); +} + + +/** Open a directory denoted by the file. */ +bool fat16_opendir(FAT16_FILE* dir) +{ + // Don't open non-dirs and "." directory. + if (!(dir->attribs & FA_DIR) || dir->type == FT_SELF) + return false; + + open_file(dir->fat, dir, dir->clu_start, 0); + return true; +} + + +void fat16_root(const FAT16* fat, FAT16_FILE* file) +{ + open_file(fat, file, 0, 0); +} + + +/** + * Find a file with given "display name" in this directory. + * If file is found, "dir" will contain it's handle. + * Either way, "dir" gets modified and you may need to rewind it afterwards. + */ +bool fat16_find(FAT16_FILE* dir, const char* name) +{ + char fname[11]; + fat16_rawname(name, fname); + return dir_find_file_raw(dir, fname); +} + + +/** Go through a directory, and "open" first FT_NONE or FT_DELETED file entry. */ +bool find_empty_file_slot(FAT16_FILE* file) +{ + const uint16_t clu = file->clu; + const FAT16* fat = file->fat; + + // Find free directory entry that can be used + for (uint16_t num = 0; num < 0xFFFF; num++) + { + // root directory has fewer entries, error if trying + // to add one more. + if (file->clu == 0 && num >= fat->bs.root_entries) + return false; + + // Resolve addres of next file entry + uint32_t addr; + do + { + addr = clu_offs(fat, file->clu, num * 32); + + if (addr == 0xFFFF) + { + // end of chain of allocated clusters for the directory + // append new cluster, return false on failure + if (!append_cluster(fat, file->clu)) return false; + } + + // if new cluster was just added, repeat. + } + while (addr == 0xFFFF); + + // Open the file entry + open_file(fat, file, clu, num); + + // Check if can be overwritten + if (file->type == FT_DELETED || file->type == FT_NONE) + { + return true; + } + } + + return false; // not found. +} + + + +bool fat16_mkfile(FAT16_FILE* file, const char* name) +{ + // Convert filename to zero padded raw string + char fname[11]; + fat16_rawname(name, fname); + + // Abort if file already exists + bool exists = dir_find_file_raw(file, fname); + fat16_first(file); // rewind dir + if (exists) + return false; // file already exists in the dir. + + + if (!find_empty_file_slot(file)) + return false; // error finding a slot + + // Write into the new slot + const uint16_t newclu = alloc_cluster(file->fat); + write_file_header(file, fname, 0, newclu); + + return true; +} + + +/** + * Create a sub-directory of given name. + * Directory is allocated and populated with entries "." and ".." + */ +bool fat16_mkdir(FAT16_FILE* file, const char* name) +{ + // Convert filename to zero padded raw string + char fname[11]; + fat16_rawname(name, fname); + + // Abort if file already exists + bool exists = dir_find_file_raw(file, fname); + fat16_first(file); // rewind dir + if (exists) + return false; // file already exusts in the dir. + + if (!find_empty_file_slot(file)) + return false; // error finding a slot + + + // Write into the new slot + const uint16_t newclu = alloc_cluster(file->fat); + write_file_header(file, fname, FA_DIR, newclu); + + const uint32_t parent_clu = file->clu; + open_file(file->fat, file, file->clu_start, 0); + + write_file_header(file, ". ", FA_DIR, newclu); + + // Advance to next file slot + find_empty_file_slot(file); + + write_file_header(file, ".. ", FA_DIR, parent_clu); + + // rewind. + fat16_first(file); + + return true; +} + + +char* fat16_disk_label(const FAT16* fat, char* label_out) +{ + FAT16_FILE first; + fat16_root(fat, &first); + + if (first.type == FT_LABEL) + { + return fat16_dispname(&first, label_out); + } + + // find where spaces end + int8_t j = 10; + for (; j >= 0; j--) + { + if (fat->bs.volume_label[j] != ' ') break; + } + + // copy all until spaces + uint8_t i; + for (i = 0; i <= j; i++) + { + label_out[i] = fat->bs.volume_label[i]; + } + + label_out[i] = 0; // ender + + return label_out; +} + + +char* fat16_dispname(const FAT16_FILE* file, char* disp_out) +{ + // Cannot get name for special files + if (file->type == FT_NONE || // not-yet-used directory location + file->type == FT_DELETED || // deleted file entry + file->attribs == 0x0F) // long name special entry (system, hidden) + return NULL; + + // find first non-space + int8_t j = 7; + for (; j >= 0; j--) + { + if (file->name[j] != ' ') break; + } + + // j ... last no-space char + + uint8_t i; + for (i = 0; i <= j; i++) + { + disp_out[i] = file->name[i]; + } + + + // directory entry, no extension + if (file->type == FT_SUBDIR || file->type == FT_SELF || file->type == FT_PARENT) + { + disp_out[i] = 0; // end of string + return disp_out; + } + + + // add a dot + if (file->type != FT_LABEL) // volume label has no dot! + disp_out[i++] = '.'; + + // Add extension chars + for (j = 8; j < 11; j++, i++) + { + const char c = file->name[j]; + if (c == ' ') break; + disp_out[i] = c; + } + + disp_out[i] = 0; // end of string + + return disp_out; +} + + +char* fat16_rawname(const char* disp_in, char* raw_out) +{ + uint8_t name_c = 0, wr_c = 0; + bool filling = false; + bool at_ext = false; + for (; wr_c < 11; wr_c++) + { + // start filling with spaces if end of filename reached + uint8_t c = disp_in[name_c]; + // handle special rule for 0xE5 + if (name_c == 0 && c == 0xE5) + { + c = 0x05; + } + + if (c == '.' || c == 0) + { + if (!filling) + { + filling = true; + + if (c == '.') + { + name_c++; // skip the dot + c = disp_in[name_c]; + at_ext = true; + } + } + } + + // if at the start of ext + if (wr_c == 8) + { + if (!at_ext) + { + // try to advance past dot (if any) + while (true) + { + c = disp_in[name_c++]; + if (c == 0) break; + if (c == '.') + { + // read char PAST the dot + c = disp_in[name_c]; + at_ext = true; + break; + } + } + } + + // if c has valid char for extension + if (c != 0 && c != '.') + { + // start copying again. + filling = false; + } + } + + if (!filling) + { + // copy char of filename + raw_out[wr_c] = disp_in[name_c++]; + } + else + { + // add a filler space + raw_out[wr_c] = ' '; + } + } + + return raw_out; +} + + +/** Write new file size (also to the disk). Does not allocate clusters. */ +void fat16_resize(FAT16_FILE* file, uint32_t size) +{ + const FAT16* fat = file->fat; + const BLOCKDEV* dev = file->fat->dev; + + // Find address for storing the size + const uint32_t addr = clu_offs(fat, file->clu, file->num * 32 + 28); + file->size = size; + + dev->seek(addr); + dev->store(&size, 4); + + // Seek to the end of the file, to make sure clusters are allocated + fat16_seek(file, size - 1); + + const uint16_t next = next_clu(fat, file->cur_clu); + if (next != 0xFFFF) + { + free_cluster_chain(fat, next); + + // Mark that there's no further clusters + write_fat(fat, file->cur_clu, 0xFFFF); + } +} + +/** Low level no-check file delete and free */ +void delete_file_do(FAT16_FILE* file) +{ + const FAT16* fat = file->fat; + + // seek to file record + fat->dev->seek(clu_offs(fat, file->clu, file->num * 32)); + + // mark as deleted + fat->dev->write(0xE5); // "deleted" mark + + // Free clusters, if FILE or SUBDIR and valid clu_start + if (file->type == FT_FILE || file->type == FT_SUBDIR) + { + // free allocated clusters + free_cluster_chain(fat, file->clu_start); + } + + file->type = FT_DELETED; +} + + +/** Delete a simple file */ +bool fat16_rmfile(FAT16_FILE* file) +{ + switch (file->type) + { + case FT_FILE: + case FT_INVALID: + case FT_LFN: + case FT_LABEL: + delete_file_do(file); + return true; + + default: + return false; + } + +} + + +/** Delete an empty directory */ +bool fat16_rmdir(FAT16_FILE* file) +{ + if (file->type != FT_SUBDIR) + return false; // not a subdirectory entry + + const FAT16* fat = file->fat; + + const uint16_t clu1 = file->clu; + const uint16_t num1 = file->num; + + + // Open the subdir + if (!fat16_opendir(file)) + return false; // could not open + + // Look for valid files and subdirs in the directory + uint8_t cnt = 0; // entry counter, for checking "." and ".." + do + { + // Stop on apparent corrupt structure (missing "." or "..") + // Can safely delete the folder. + if (cnt == 0 && file->type != FT_SELF) break; + if (cnt == 1 && file->type != FT_PARENT) break; + + // Found valid file + if (file->type == FT_SUBDIR || file->type == FT_FILE) + { + // Valid child file was found, aborting. + // reopen original file + open_file(fat, file, clu1, num1); + return false; + } + + if (cnt < 2) cnt++; + } + while (fat16_next(file)); + + // reopen original file + open_file(fat, file, clu1, num1); + + // and delete as ordinary file + delete_file_do(file); + + return true; +} + + +bool fat16_delete(FAT16_FILE* file) +{ + switch (file->type) + { + case FT_DELETED: + case FT_NONE: + return true; // "deleted successfully" + + case FT_SUBDIR:; // semicolon needed to allow declaration after "case" + + // store original file location + const uint16_t clu1 = file->clu; + const uint16_t num1 = file->num; + + // open the directory (skip "." and "..") + open_file(file->fat, file, file->clu_start, 2); + + // delete all children + do + { + if (!fat16_delete(file)) + { + // failure + // reopen original file + open_file(file->fat, file, clu1, num1); + return false; + } + } + while (fat16_next(file)); + + // go up and delete the dir + open_file(file->fat, file, clu1, num1); + return fat16_rmdir(file); + + default: + // try to delete as a regular file + return fat16_rmfile(file); + } +} + + +bool fat16_parent(FAT16_FILE* file) +{ + const uint16_t clu1 = file->clu; + const uint16_t num1 = file->num; + + // open second entry of the directory + open_file(file->fat, file, file->clu, 1); + + // if it's a valid PARENT link, follow it. + if (file->type == FT_PARENT) + { + open_file(file->fat, file, file->clu_start, 0); + return true; + } + else + { + // in root already? + // reopen original file + open_file(file->fat, file, clu1, num1); + return false; + } +} diff --git a/lib/fat16.h b/lib/fat16.h new file mode 100644 index 0000000..477305a --- /dev/null +++ b/lib/fat16.h @@ -0,0 +1,251 @@ +#pragma once + +#include +#include + +/** + * Abstract block device interface + * + * Populate this with pointers to your I/O functions. + */ +typedef struct +{ + // Sequential read + void (*load)(void* dest, const uint16_t len); + // Sequential write + void (*store)(const void* src, const uint16_t len); + // Sequential byte write + void (*write)(const uint8_t b); + // Sequential byte read + uint8_t (*read)(void); + // Absolute seek + void (*seek)(const uint32_t); + // Relative seek + void (*rseek)(const int16_t); +} BLOCKDEV; + + +// ------------------------------- + +/** + * File types (values can be used for debug printing). + * Accessible using file->type + */ +typedef enum +{ + FT_NONE = '-', + FT_DELETED = 'x', + FT_SUBDIR = 'D', + FT_PARENT = 'P', + FT_LABEL = 'L', + FT_LFN = '~', + FT_INVALID = '?', // not recognized weird file + FT_SELF = '.', + FT_FILE = 'F' +} FAT16_FT; + + +// Include definitions of fully internal structs +#include "fat16_internal.h" + + +/** + * File handle struct. + * + * File handle contains cursor, file name, type, size etc. + * Everything (files, dirs) is accessed using this. + */ +typedef struct __attribute__((packed)) +{ + /** + * Raw file name. Starting 0x05 was converted to 0xE5. + * To get PRINTABLE file name, use fat16_dispname() + */ + uint8_t name[11]; + + /** + * File attributes - bit field composed of FA_* flags + * (internal) + */ + uint8_t attribs; + + // 14 bytes skipped (10 reserved, date, time) + + /** First cluster of the file. (internal) */ + uint16_t clu_start; + + /** + * File size in bytes. + * This is the current allocated and readable file size. + */ + uint32_t size; + + + // --- the following fields are added when reading --- + + /** File type. */ + FAT16_FT type; + + + // --- INTERNAL FIELDS --- + + // Cursor variables. (internal) + uint32_t cur_abs; // absolute position in device + uint32_t cur_rel; // relative position in file + uint16_t cur_clu; // cluster where the cursor is + uint16_t cur_ofs; // offset within the active cluster + + // File position in the directory. (internal) + uint16_t clu; // first cluster of directory + uint16_t num; // file entry number + + // Pointer to the FAT16 handle. (internal) + const FAT16* fat; +} +FAT16_FILE; + + +/** Initialize the file system - store into "fat" */ +void fat16_init(const BLOCKDEV* dev, FAT16* fat); + + +/** + * Open the first file of the root directory. + * The file may be invalid (eg. a volume label, deleted etc), + * or blank (type FT_NONE) if the filesystem is empty. + */ +void fat16_root(const FAT16* fat, FAT16_FILE* file); + + +/** + * Resolve the disk label. + * That can be in the Boot Sector, or in the first root directory entry. + */ +char* fat16_disk_label(const FAT16* fat, char* label_out); + + +// ----------- FILE I/O ------------- + + +/** + * Move file cursor to a position relative to file start + * Returns false on I/O error (bad file, out of range...) + */ +bool fat16_seek(FAT16_FILE* file, uint32_t addr); + + +/** + * Read bytes from file into memory + * Returns false on I/O error (bad file, out of range...) + */ +bool fat16_read(FAT16_FILE* file, void* target, uint32_t len); + + +/** + * Write into file at a "seek" position. + * "seek" cursor must be within (0..filesize) + */ +bool fat16_write(FAT16_FILE* file, void* source, uint32_t len); + + +/** + * Create a new file in given folder + * + * file ... open directory; new file is opened into this handle. + * name ... name of the new file, including extension + */ +bool fat16_mkfile(FAT16_FILE* file, const char* name); + + +/** + * Create a sub-directory of given name. + * Directory is allocated and populated with entries "." and ".." + */ +bool fat16_mkdir(FAT16_FILE* file, const char* name); + + +/** + * Set new file size. + * Allocates / frees needed clusters, does NOT erase them. + * + * Useful mainly for shrinking. + */ +void fat16_resize(FAT16_FILE* file, uint32_t size); + + +/** + * Delete a *FILE* and free it's clusters. + */ +bool fat16_rmfile(FAT16_FILE* file); + + +/** + * Delete an empty *DIRECTORY* and free it's clusters. + */ +bool fat16_rmdir(FAT16_FILE* file); + + +/** + * Delete a file or directory, even FT_LFN and FT_INVALID. + * Directories are deleted recursively (!) + */ +bool fat16_delete(FAT16_FILE* file); + + + +// --------- NAVIGATION ------------ + + +/** Go to previous file in the directory (false = no prev file) */ +bool fat16_prev(FAT16_FILE* file); + + +/** Go to next file in directory (false = no next file) */ +bool fat16_next(FAT16_FILE* file); + + +/** + * Open a subdirectory denoted by the file. + * Provided handle changes to the first entry of the directory. + */ +bool fat16_opendir(FAT16_FILE* dir); + + +/** + * Open a parent directory. Fails in root. + * Provided handle changes to the first entry of the parent directory. + */ +bool fat16_parent(FAT16_FILE* file); + + +/** Jump to first file in this directory */ +void fat16_first(FAT16_FILE* file); + + +/** + * Find a file with given "display name" in this directory. + * If file is found, "dir" will contain it's handle. + * If file is NOT found, the handle points to the last entry of the directory. + */ +bool fat16_find(FAT16_FILE* dir, const char* name); + + +// -------- FILE INSPECTION ----------- + +/** Check if file is a valid entry, or long-name/label/deleted */ +bool fat16_is_regular(const FAT16_FILE* file); + + +/** + * Resolve a file name, trim spaces and add null terminator. + * Returns the passed char*, or NULL on error. + */ +char* fat16_dispname(const FAT16_FILE* file, char* disp_out); + + +/** + * Convert filename to zero-padded fixed length one + * Returns the passed char*. + */ +char* fat16_rawname(const char* disp_in, char* raw_out); + diff --git a/lib/fat16_internal.h b/lib/fat16_internal.h new file mode 100644 index 0000000..9f196e6 --- /dev/null +++ b/lib/fat16_internal.h @@ -0,0 +1,65 @@ +#pragma once + +#include +#include + +// Internal types and stuff that is needed in the header for declarations, +// but is not a part of the public API. + +/** Boot Sector structure */ +typedef struct __attribute__((packed)) +{ + + // Fields loaded directly from disk: + + // 13 bytes skipped + uint8_t sectors_per_cluster; + uint16_t reserved_sectors; + uint8_t num_fats; + uint16_t root_entries; + // 3 bytes skipped + uint16_t fat_size_sectors; + // 8 bytes skipped + uint32_t total_sectors; // if "short size sectors" is used, it's copied here too + // 7 bytes skipped + char volume_label[11]; // space padded, no terminator + + // Added fields: + + uint32_t bytes_per_cluster; + +} +Fat16BootSector; + + +/** FAT filesystem handle */ +typedef struct __attribute__((packed)) +{ + // Backing block device + const BLOCKDEV* dev; + + // Root directory sector start + uint32_t rd_addr; + + // Start of first cluster (number "2") + uint32_t data_addr; + + // Start of fat table + uint32_t fat_addr; + + // Boot sector data struct + Fat16BootSector bs; +} +FAT16; + + +/** + * File Attributes (bit flags) + * Accessible using file->attribs + */ +#define FA_READONLY 0x01 // read only file +#define FA_HIDDEN 0x02 // hidden file +#define FA_SYSTEM 0x04 // system file +#define FA_LABEL 0x08 // volume label entry, found only in root directory. +#define FA_DIR 0x10 // subdirectory +#define FA_ARCHIVE 0x20 // archive flag diff --git a/lib/lcd.c b/lib/lcd.c index a9ceb13..68513f5 100644 --- a/lib/lcd.c +++ b/lib/lcd.c @@ -42,12 +42,14 @@ uint8_t _lcd_read_byte(); // 0 W, 1 R bool _lcd_mode; -struct { +struct +{ uint8_t x; uint8_t y; } _pos; -enum { +enum +{ TEXT = 0, CG = 1 } _addrtype; @@ -167,15 +169,18 @@ void lcd_command(uint8_t bb) /** Write a data byte */ void lcd_write(uint8_t bb) { - if (_addrtype == TEXT) { - if (bb == '\r') { + if (_addrtype == TEXT) + { + if (bb == '\r') + { // CR _pos.x = 0; lcd_xy(_pos.x, _pos.y); return; } - if (bb == '\n') { + if (bb == '\n') + { // LF _pos.y++; lcd_xy(_pos.x, _pos.y); @@ -227,7 +232,7 @@ void _lcd_write_byte(uint8_t bb) void _lcd_wait_bf() { uint8_t d = 0; - while(d++ < 120 && lcd_read_bf_addr() & _BV(7)) + while (d++ < 120 && lcd_read_bf_addr() & _BV(7)) _delay_us(1); } @@ -318,7 +323,8 @@ void lcd_clear() void lcd_glyph(const uint8_t index, const uint8_t* array) { lcd_addr_cg(index * 8); - for (uint8_t i = 0; i < 8; ++i) { + for (uint8_t i = 0; i < 8; ++i) + { lcd_write(array[i]); } @@ -332,7 +338,8 @@ void lcd_glyph(const uint8_t index, const uint8_t* array) void lcd_glyph_P(const uint8_t index, const uint8_t* array) { lcd_addr_cg(index * 8); - for (uint8_t i = 0; i < 8; ++i) { + for (uint8_t i = 0; i < 8; ++i) + { lcd_write(pgm_read_byte(&array[i])); } diff --git a/lib/onewire.c b/lib/onewire.c index 97bea71..5ba960a 100644 --- a/lib/onewire.c +++ b/lib/onewire.c @@ -31,11 +31,14 @@ void _ow_tx_bit(const uint8_t pin, const bool bit) as_output_n(pin); pin_low_n(pin); - if (bit) { + if (bit) + { _delay_us(6); as_input_pu_n(pin); _delay_us(64); - } else { + } + else + { _delay_us(60); as_input_pu_n(pin); _delay_us(10); @@ -137,7 +140,7 @@ void ow_read_arr(const uint8_t pin, uint8_t* array, const uint8_t count) // Dallas 1-wire 16-bit CRC calculation. Developed from Maxim Application Note 27. /** Compute a CRC16 checksum */ -uint16_t crc16( uint8_t *data, uint8_t len) +uint16_t crc16(uint8_t *data, uint8_t len) { uint16_t crc = 0; @@ -174,7 +177,7 @@ uint8_t crc8(uint8_t *addr, uint8_t len) uint8_t mix = (crc ^ inbyte) & 0x01; crc >>= 1; if (mix) - crc ^= 0x8C; + crc ^= 0x8C; inbyte >>= 1; } @@ -195,9 +198,12 @@ int16_t ds1820_read_temp(uint8_t pin) ow_read_arr(pin, bytes, 9); uint8_t crc = crc8(bytes, 8); - if (crc != bytes[8]) { + if (crc != bytes[8]) + { return TEMP_ERROR; - } else { + } + else + { int16_t a = ((bytes[1] << 8) | bytes[0]) >> 1; a = a << 4; a += (16 - bytes[6]) & 0x0F; @@ -230,7 +236,8 @@ bool ds1820_single_measure(uint8_t pin) ow_send(pin, SKIP_ROM); ow_send(pin, CONVERT_T); - if(!ow_wait_ready(pin)) { + if (!ow_wait_ready(pin)) + { return false; } diff --git a/lib/onewire.h b/lib/onewire.h index 24e4a6c..38e292b 100644 --- a/lib/onewire.h +++ b/lib/onewire.h @@ -27,7 +27,7 @@ bool ow_wait_ready(const uint8_t pin); void ow_read_arr(const uint8_t pin, uint8_t* array, const uint8_t count); /** Compute a CRC16 checksum */ -uint16_t crc16( uint8_t *data, uint8_t len); +uint16_t crc16(uint8_t *data, uint8_t len); /** Compute a CRC8 checksum */ uint8_t crc8(uint8_t *addr, uint8_t len); diff --git a/lib/sonar.c b/lib/sonar.c index d392d04..b9f12aa 100644 --- a/lib/sonar.c +++ b/lib/sonar.c @@ -23,10 +23,19 @@ void _sonar_init_do(sonar_t* so, PORT_P port, uint8_t ntx, PORT_P pin, uint8_t n so->pin = pin; so->nrx = nrx; - switch((const uint16_t) pin) { - case ((const uint16_t) &PINB): so->bank = 0; break; - case ((const uint16_t) &PINC): so->bank = 1; break; - case ((const uint16_t) &PIND): so->bank = 2; break; + switch ((const uint16_t) pin) + { + case ((const uint16_t) &PINB): + so->bank = 0; + break; + + case ((const uint16_t) &PINC): + so->bank = 1; + break; + + case ((const uint16_t) &PIND): + so->bank = 2; + break; } } @@ -56,10 +65,19 @@ bool sonar_start(sonar_t* so) TCNT1 = 0; // Set up pin change interrupt mask for the RX pin - switch(so->bank) { - case 0: sbi(PCMSK0, so->nrx); break; - case 1: sbi(PCMSK1, so->nrx); break; - case 2: sbi(PCMSK2, so->nrx); break; + switch (so->bank) + { + case 0: + sbi(PCMSK0, so->nrx); + break; + + case 1: + sbi(PCMSK1, so->nrx); + break; + + case 2: + sbi(PCMSK2, so->nrx); + break; } // send positive pulse @@ -87,10 +105,19 @@ void _sonar_stop() TCCR1B = 0; // Disable RX pin interrupt mask - switch(_so->bank) { - case 0: PCMSK0 &= ~(1 << (_so->nrx)); break; - case 1: PCMSK1 &= ~(1 << (_so->nrx)); break; - case 2: PCMSK2 &= ~(1 << (_so->nrx)); break; + switch (_so->bank) + { + case 0: + PCMSK0 &= ~(1 << (_so->nrx)); + break; + + case 1: + PCMSK1 &= ~(1 << (_so->nrx)); + break; + + case 2: + PCMSK2 &= ~(1 << (_so->nrx)); + break; } // Disable timer1 overflow interrupt @@ -115,11 +142,13 @@ inline bool sonar_handle_t1ovf() /** Handle pin change interrupt (returns true if consumed) */ inline bool sonar_handle_pci() { - if (!sonar_busy) { + if (!sonar_busy) + { return false; // nothing } - if (bit_is_high_p(_so->pin, _so->nrx)) { + if (bit_is_high_p(_so->pin, _so->nrx)) + { // rx is high, not our pin change event return false; } diff --git a/lib/sonar.h b/lib/sonar.h index 0a92764..9e8d3ae 100644 --- a/lib/sonar.h +++ b/lib/sonar.h @@ -25,7 +25,8 @@ // Sonar data object -typedef struct { +typedef struct +{ PORT_P port; // Tx PORT uint8_t ntx; // Tx bit number PORT_P pin; // Rx PIN diff --git a/lib/stream.c b/lib/stream.c index 9397b73..c5b0c65 100644 --- a/lib/stream.c +++ b/lib/stream.c @@ -12,7 +12,8 @@ static char tmpstr[20]; // buffer for number rendering void put_str(const STREAM *p, char* str) { char c; - while ((c = *str++)) { + while ((c = *str++)) + { p->tx(c); } } @@ -21,7 +22,8 @@ void put_str(const STREAM *p, char* str) void put_str_P(const STREAM *p, const char* str) { char c; - while ((c = pgm_read_byte(str++))) { + while ((c = pgm_read_byte(str++))) + { p->tx(c); } } @@ -82,15 +84,22 @@ void put_i32(const STREAM *p, const int32_t num) /** Print number as hex */ void _print_hex(const STREAM *p, uint8_t* start, uint8_t bytes) { - for (; bytes > 0; bytes--) { + for (; bytes > 0; bytes--) + { uint8_t b = *(start + bytes - 1); - for(uint8_t j = 0; j < 2; j++) { + for (uint8_t j = 0; j < 2; j++) + { uint8_t x = high_nibble(b); + b = b << 4; - if (x < 0xA) { + + if (x < 0xA) + { p->tx('0' + x); - } else { + } + else + { p->tx('A' + (x - 0xA)); } } @@ -140,10 +149,13 @@ void put_u16f(const STREAM *p, const uint16_t num, const uint8_t places) /** Send signed int as float */ void put_i16f(const STREAM *p, const int16_t num, const uint8_t places) { - if (num < 0) { + if (num < 0) + { p->tx('-'); itoa(-num, tmpstr, 10); - } else { + } + else + { itoa(num, tmpstr, 10); } @@ -162,10 +174,13 @@ void put_u32f(const STREAM *p, const uint32_t num, const uint8_t places) /** Send signed long as float */ void put_i32f(const STREAM *p, const int32_t num, const uint8_t places) { - if (num < 0) { + if (num < 0) + { p->tx('-'); ltoa(-num, tmpstr, 10); - } else { + } + else + { ltoa(num, tmpstr, 10); } @@ -178,15 +193,17 @@ void _putnf(const STREAM *p, const uint8_t places) { // measure text length uint8_t len = 0; - while(tmpstr[len] != 0) len++; + while (tmpstr[len] != 0) len++; int8_t at = len - places; // print virtual zeros - if (at <= 0) { + if (at <= 0) + { p->tx('0'); p->tx('.'); - while(at <= -1) { + while (at <= -1) + { p->tx('0'); at++; } @@ -195,8 +212,10 @@ void _putnf(const STREAM *p, const uint8_t places) // print the number uint8_t i = 0; - while(i < len) { - if (at-- == 0) { + while (i < len) + { + if (at-- == 0) + { p->tx('.'); } diff --git a/lib/stream.h b/lib/stream.h index 8ed7979..95a8a09 100644 --- a/lib/stream.h +++ b/lib/stream.h @@ -23,9 +23,10 @@ #include /** Stream structure */ -typedef struct { - void (*tx) (uint8_t b); - uint8_t (*rx) (void); +typedef struct +{ + void (*tx)(uint8_t b); + uint8_t (*rx)(void); } STREAM; diff --git a/lib/uart.c b/lib/uart.c index e2a477b..8657fa1 100644 --- a/lib/uart.c +++ b/lib/uart.c @@ -14,9 +14,10 @@ static STREAM _uart_singleton; STREAM* uart; -void _uart_init_do(uint16_t ubrr) { +void _uart_init_do(uint16_t ubrr) +{ /*Set baud rate */ - UBRR0H = (uint8_t) (ubrr >> 8); + UBRR0H = (uint8_t)(ubrr >> 8); UBRR0L = (uint8_t) ubrr; // Enable Rx and Tx @@ -76,7 +77,8 @@ uint8_t uart_rx() /** Send string over UART */ void uart_puts(const char* str) { - while (*str) { + while (*str) + { uart_tx(*str++); } } @@ -86,7 +88,8 @@ void uart_puts(const char* str) void uart_puts_P(const char* str) { char c; - while ((c = pgm_read_byte(str++))) { + while ((c = pgm_read_byte(str++))) + { uart_tx(c); } } @@ -96,7 +99,8 @@ void uart_puts_P(const char* str) void uart_flush() { uint8_t dummy; - while (bit_is_high(UCSR0A, RXC0)) { + while (bit_is_high(UCSR0A, RXC0)) + { dummy = UDR0; } } @@ -115,9 +119,9 @@ void vt_goto(uint8_t x, uint8_t y) { uart_tx(27); uart_tx('['); - put_u8(uart, y+1); // one-based ! + put_u8(uart, y + 1); // one-based ! uart_tx(';'); - put_u8(uart, x+1); + put_u8(uart, x + 1); uart_tx('H'); } @@ -126,7 +130,7 @@ void vt_goto_x(uint8_t x) { uart_tx(27); uart_tx('['); - put_u8(uart, x+1); + put_u8(uart, x + 1); uart_tx('`'); } @@ -135,7 +139,7 @@ void vt_goto_y(uint8_t y) { uart_tx(27); uart_tx('['); - put_u8(uart, y+1); + put_u8(uart, y + 1); uart_tx('d'); } @@ -149,9 +153,12 @@ void vt_move(int8_t x, int8_t y) void vt_move_x(int8_t x) { - if (x < 0) { + if (x < 0) + { vt_left(-x); - } else { + } + else + { vt_right(x); } } @@ -159,9 +166,12 @@ void vt_move_x(int8_t x) void vt_move_y(int8_t y) { - if (y < 0) { + if (y < 0) + { vt_up(-y); - } else { + } + else + { vt_down(y); } } @@ -209,13 +219,15 @@ void vt_right(uint8_t x) void vt_scroll(int8_t y) { - while (y < 0) { + while (y < 0) + { uart_tx(27); uart_tx('D'); // up y++; } - while (y > 0) { + while (y > 0) + { uart_tx(27); uart_tx('M'); // down y--; @@ -243,7 +255,8 @@ void vt_scroll_reset() -typedef struct { +typedef struct +{ uint8_t flags; uint8_t fg; uint8_t bg; @@ -293,11 +306,16 @@ void vt_attr(uint8_t attribute, bool on) { // flags are powers of two // so this can handle multiple OR'd flags - for(uint8_t c = 1; c <= VT_FAINT; c *= 2) { - if (attribute & c) { - if (on) { + for (uint8_t c = 1; c <= VT_FAINT; c *= 2) + { + if (attribute & c) + { + if (on) + { current_style.flags |= c; - } else { + } + else + { current_style.flags &= ~c; } } @@ -351,27 +369,33 @@ inline void _vt_reset_attribs_do() /** Send commands for text attribs */ void _vt_style_do() { - if (current_style.flags & VT_BOLD) { + if (current_style.flags & VT_BOLD) + { uart_puts_P(PSTR("\x1B[1m")); } - if (current_style.flags & VT_FAINT) { + if (current_style.flags & VT_FAINT) + { uart_puts_P(PSTR("\x1B[2m")); } - if (current_style.flags & VT_ITALIC) { + if (current_style.flags & VT_ITALIC) + { uart_puts_P(PSTR("\x1B[3m")); } - if (current_style.flags & VT_UNDERLINE) { + if (current_style.flags & VT_UNDERLINE) + { uart_puts_P(PSTR("\x1B[4m")); } - if (current_style.flags & VT_BLINK) { + if (current_style.flags & VT_BLINK) + { uart_puts_P(PSTR("\x1B[5m")); } - if (current_style.flags & VT_REVERSE) { + if (current_style.flags & VT_REVERSE) + { uart_puts_P(PSTR("\x1B[7m")); } } @@ -508,7 +532,8 @@ void vt_set_key_handler(void (*handler)(uint8_t, bool)) // state machine states -typedef enum { +typedef enum +{ GROUND = 0, ESC = 1, BR = 2, @@ -525,7 +550,8 @@ KSTATE _kstate = GROUND; void _vt_kh_abort() { - switch (_kstate) { + switch (_kstate) + { case ESC: _vt_kh(VK_ESC, true); break; @@ -564,9 +590,11 @@ void vt_handle_key(uint8_t c) { if (_vt_kh == NULL) return; - switch (_kstate) { + switch (_kstate) + { case GROUND: - switch (c) { + switch (c) + { case 27: _kstate = ESC; break; @@ -585,7 +613,8 @@ void vt_handle_key(uint8_t c) break; // continue to next char case ESC: - switch (c) { + switch (c) + { case '[': _kstate = BR; break; // continue to next char @@ -603,7 +632,8 @@ void vt_handle_key(uint8_t c) break; case BR: - switch (c) { + switch (c) + { // arrows case 65: case 66: @@ -632,7 +662,8 @@ void vt_handle_key(uint8_t c) break; case O: - switch (c) { + switch (c) + { // F keys case 80: case 81: @@ -653,11 +684,14 @@ void vt_handle_key(uint8_t c) } case WAITING_TILDE: - if (c != '~') { + if (c != '~') + { _vt_kh_abort(); vt_handle_key(c); return; - } else { + } + else + { _vt_kh(_before_wtilde, true); _kstate = GROUND; return; @@ -665,13 +699,17 @@ void vt_handle_key(uint8_t c) } // wait for next key - if (_kstate != GROUND) { + if (_kstate != GROUND) + { _delay_ms(2); - if (!uart_rx_ready()) { + if (!uart_rx_ready()) + { // abort receiving _vt_kh_abort(); - } else { + } + else + { vt_handle_key(uart_rx()); } } diff --git a/lib/wsrgb.c b/lib/wsrgb.c index 8eb2507..5714938 100644 --- a/lib/wsrgb.c +++ b/lib/wsrgb.c @@ -18,21 +18,26 @@ void ws_init() } /** Wait long enough for the colors to show */ -void ws_show() { +void ws_show() +{ delay_ns_c(WS_T_LATCH, 0); } /** Send one byte to the RGB strip */ void ws_send_byte(const uint8_t bb) { - for (volatile int8_t i = 7; i >= 0; --i) { - if ((bb) & (1 << i)) { + for (volatile int8_t i = 7; i >= 0; --i) + { + if ((bb) & (1 << i)) + { pin_high(WS_PIN); delay_ns_c(WS_T_1H, -2); pin_low(WS_PIN); delay_ns_c(WS_T_1L, -10); - } else { + } + else + { pin_high(WS_PIN); delay_ns_c(WS_T_0H, -2); @@ -72,7 +77,8 @@ void ws_send_rgb24(rgb24_t rgb) /** Send array of colors */ void ws_send_xrgb_array(const xrgb_t rgbs[], const uint8_t length) { - for (uint8_t i = 0; i < length; i++) { + for (uint8_t i = 0; i < length; i++) + { const xrgb_t c = rgbs[i]; ws_send_byte(c.g); ws_send_byte(c.r); @@ -83,7 +89,8 @@ void ws_send_xrgb_array(const xrgb_t rgbs[], const uint8_t length) /** Send array of colors */ void ws_send_rgb24_array(const rgb24_t rgbs[], const uint8_t length) { - for (uint8_t i = 0; i < length; i++) { + for (uint8_t i = 0; i < length; i++) + { const rgb24_t c = rgbs[i]; ws_send_byte(rgb24_g(c)); ws_send_byte(rgb24_r(c)); @@ -94,39 +101,39 @@ void ws_send_rgb24_array(const rgb24_t rgbs[], const uint8_t length) //#define ws_send_rgb24_array(rgbs, length) __ws_send_array_proto((rgbs), (length), rgb24) // prototype for sending array. it's ugly, sorry. -/*#define __ws_send_array_proto(rgbs, length, style) { \ - for (uint8_t __rgb_sap_i = 0; __rgb_sap_i < length; __rgb_sap_i++) { \ - style ## _t __rgb_sap2 = (rgbs)[__rgb_sap_i]; \ - ws_send_ ## style(__rgb_sap2); \ - } \ +/*#define __ws_send_array_proto(rgbs, length, style) { \ + for (uint8_t __rgb_sap_i = 0; __rgb_sap_i < length; __rgb_sap_i++) { \ + style ## _t __rgb_sap2 = (rgbs)[__rgb_sap_i]; \ + ws_send_ ## style(__rgb_sap2); \ + } \ }*/ // /** Send a 2D array to a zig-zag display */ -// #define ws_send_xrgb_array_zigzag(rgbs, width, height) { \ -// int8_t __rgb_sxaz_y, __rgb_sxaz_x; \ -// for(__rgb_sxaz_y = 0; __rgb_sxaz_y < (height); __rgb_sxaz_y ++) { \ -// for(__rgb_sxaz_x = 0; __rgb_sxaz_x < (width); __rgb_sxaz_x++) { \ -// ws_send_xrgb((rgbs)[__rgb_sxaz_y][__rgb_sxaz_x]); \ -// } \ -// __rgb_sxaz_y++; \ -// for(__rgb_sxaz_x = (width) - 1; __rgb_sxaz_x >= 0; __rgb_sxaz_x--) { \ -// ws_send_xrgb((rgbs)[__rgb_sxaz_y][__rgb_sxaz_x]); \ -// } \ -// } \ +// #define ws_send_xrgb_array_zigzag(rgbs, width, height) { \ +// int8_t __rgb_sxaz_y, __rgb_sxaz_x; \ +// for(__rgb_sxaz_y = 0; __rgb_sxaz_y < (height); __rgb_sxaz_y ++) { \ +// for(__rgb_sxaz_x = 0; __rgb_sxaz_x < (width); __rgb_sxaz_x++) { \ +// ws_send_xrgb((rgbs)[__rgb_sxaz_y][__rgb_sxaz_x]); \ +// } \ +// __rgb_sxaz_y++; \ +// for(__rgb_sxaz_x = (width) - 1; __rgb_sxaz_x >= 0; __rgb_sxaz_x--) { \ +// ws_send_xrgb((rgbs)[__rgb_sxaz_y][__rgb_sxaz_x]); \ +// } \ +// } \ // } // /* Send a linear array to a zig-zag display as a n*m board (row-by-row) -// #define ws_send_xrgb_array_zigzag_linear(rgbs, width, height) { \ -// int8_t __rgb_sxazl_x, __rgb_sxazl_y; \ -// for(__rgb_sxazl_y = 0; __rgb_sxazl_y < (height); __rgb_sxazl_y++) { \ -// for(__rgb_sxazl_x = 0; __rgb_sxazl_x < (width); __rgb_sxazl_x++) { \ -// ws_send_xrgb((rgbs)[__rgb_sxazl_y * (width) + __rgb_sxazl_x]); \ -// } \ -// __rgb_sxazl_y++; \ -// for(__rgb_sxazl_x = width-1; __rgb_sxazl_x >=0; __rgb_sxazl_x--) { \ -// ws_send_xrgb((rgbs)[__rgb_sxazl_y * (width) + __rgb_sxazl_x]); \ -// } \ -// } \ +// #define ws_send_xrgb_array_zigzag_linear(rgbs, width, height) { \ +// int8_t __rgb_sxazl_x, __rgb_sxazl_y; \ +// for(__rgb_sxazl_y = 0; __rgb_sxazl_y < (height); __rgb_sxazl_y++) { \ +// for(__rgb_sxazl_x = 0; __rgb_sxazl_x < (width); __rgb_sxazl_x++) { \ +// ws_send_xrgb((rgbs)[__rgb_sxazl_y * (width) + __rgb_sxazl_x]); \ +// } \ +// __rgb_sxazl_y++; \ +// for(__rgb_sxazl_x = width-1; __rgb_sxazl_x >=0; __rgb_sxazl_x--) { \ +// ws_send_xrgb((rgbs)[__rgb_sxazl_y * (width) + __rgb_sxazl_x]); \ +// } \ +// } \ // }